*************************************** * * dies ist die prcedure und function * sammlung f€r fdb * * (C) hado hein 1991 * 0161-XXXoutdatedXXX * * keine verwendung des programmcodes ohne * mein einverst€ndnis * * einsatz nur nach lizenzvertrag * *************************************** * * * * alles was jetzt kommt sind die ganzen * proc's und func's die man so in einem * programm braucht... * * gott hab sie selig, auch wenn sie manchmal * sinnlos sind. * * *************************************** * *ku_disp um einen kunden-satz anzuzeigen * * proc ku_disp do ssc @ 5,5 say "Firma :" @ 6,5 say "Name :" @ 7,5 say "Strasse :" @ 8,5 say "Stadt :" @ 9,5 say "Telefon :" @ 10,5 say "Telefon2:" @ 11,5 say "Tel3/FAX:" @ 12,5 say "Notizen :" @ 13,5 say "Anspechp:" @ 14,5 say "Anlage :" @ 14,32 say "von" do hell @ 05,15 say KUDA->FIRMA @ 06,15 say KUDA->NAME @ 07,15 say KUDA->STRASSE @ 08,15 say KUDA->PLZ @ 08,20 say KUDA->STADT @ 09,15 say KUDA->T_1 @ 10,15 say KUDA->T_2 @ 11,15 say KUDA->T_3 if memoda() @12,15 say "Notiz-Zettel vorhanden" else @12,15 say "Notiz-Zettel leer" endif @ 13,15 say KUDA->ANSPRECHP @ 14,15 say KUDA->TYP @ 14,36 say KUDA->HERST return * **************************************** * *ad_disp um einen artikel-satz anzuzeigen * * proc ad_disp private z store 5 to z do ssc for i = 1 to 11 @ z,09 say au[i] z=z+1 next do hell @ 05,20 say ARDA->TYP @ 06,20 say ARDA->DATUM @ 07,20 say ARDA->AD1 @ 08,20 say ARDA->AD2 @ 09,20 say ARDA->AD3 @ 10,20 say ARDA->AD4 @ 11,20 say ARDA->AD5 @ 12,20 say ARDA->AD6 @ 13,20 say ARDA->AD7 @ 14,20 say ARDA->AD8 @ 15,20 say ARDA->AD9 do wt return * *************************************** * * Hier ist die guten-tag-sagen-proc * * procedure hello * do while empty(bedienername) do frame progteil="---LOG IN---" do ssc do nachricht with "Geben Sie Ihren Namen ein." @10,10 say "Diese Version der flexiblen Datenverwaltung" @11,10 say "ist f€r folgende Firma lizensiert :" do inv @13,10 say sv_lna @14,10 say sv_lad do norm @18,10 say "Geben Sie bitte Ihren Namen ein !" @20,10 get bedienername picture "@K" read enddo * if !lizenz do frame do ssc do nachricht with "Warten Sie einfach einen Moment" select 1 if reccount() > 50 go top delete next 35 pack endif do ssc do lauf with 12,"SHAREWARE € !!! € SHAREWARE" clear typeahead lizenz = .t. endif * * * * **************************************** * * proc's norm,inv,hell und blink * f€r die umschaltung der textattribute * * dank an stefan thiemer * * proc norm set color to &c_n return * proc hell set color to &c_h return * proc blink set color to &c_b return * proc inv set color to &c_i return * *************************************** * * * cout ist f€r die zentrierte ausgabe in einer * bestimmten zeile * * dank an stefan thiemer von wom zv kiel * * para r ist die zeile * para t ist der text * proc cout para r,t private sp sp=40-int(len(t)/2) if r = 0 r=1 &&* soll ja nicht in den rahmen gehen endif @ r,sp say left(t,78) &&* oder zu lang sein ... return * *************************************** * * * nachricht ist die proc um in der 23. zeile * eine systemnachricht auszugeben. * sie f€ngt in der 14. sp an. Davor steht noch was * * idee auch von stefan * * para msg ist der text * proc nachricht parameter msg if pcount()=0 &&* wenn nix, dann msg=repl("€",48) &&* zeile einfach l€schen else &&* msg=msg+" "+repl("€",47) &&* auff€llen endif &&* voll geil ehy @ 23,14 clear to 23,63 do hell @ 23,14 say left(msg,48) do norm return * *************************************** * * * in der letzten zeile steht immer der programmteil * diese proc schreibt sie immer brav in die ecke. * * var progteil ist ja hoffentlich immer definiert * * proc progwrite private textline store space(14) to textline textline=upper(progteil)+textline @ 23,64 clear to 23,78 do inv @ 23,64 say left(textline,14) do norm return * *************************************** * * frame baut den €u€eren rahmen f€r den monitor * auf. * * proc frame do norm clear @ 0,0 to 24,79 double @ 1,1 to 1,78 if masterbed &&* irgendwie mu€ man den modus ja do inv &&* darstellen. hauptsache man wei€ end &&* das man drin ist. do cout with 0," flex_db f€r "+upper(trim; (sv_lna))+" " do norm &&* falls inv an dann wieder aus sonst &&* verschwendeter prg-code @ 3,1 to 3,78 double @ 22,1 to 22,78 double @ 23,2 say "Nachricht :" do ssc do norm return * *************************************** * * * * proc ssc ist daf€r da den normalen programm- * arbeitsbereich zu l€schen und progwrite * auszul€sen * * * proc ssc do norm @4,1 clear to 21,78 * jetzt bauen wir * uns mal einen textstring private textline store dtoc(date())+" Bediener : "+upper(Bedienername)+; +"/"+alltrim(netname())+; " " to textline do cout with 2,textline do progwrite do nachricht do norm return * *************************************** * * * proc wt ist mit eine h€ufigst gebrauchten * proc's im programm * * sie wartet auf einen tastendruck... * * * proc wt do nachricht with "Dr€cken Sie bitte eine Taste." SOUND(warn_sound) inkey(0) do nachricht do norm return * *************************************** * * * * func printcheck testet ob der drucker online ist * func printcheck private ruck,prog_alt prog_alt=progteil progteil="Druckerkontrolle" ruck=.f. do ssc if !isprinter() do ssc do blink SOUND(warn_sound) @12,10 say "Schalten Sie den Drucker ein !!!" do hell @14,10 say "Wenn bereit," @15,10 say "dann bitte eine Taste dr€cken" @17,10 say "Wenn Sie den Drucker nicht bereit machen k€nnen," @18,10 say "dann dr€cken Sie " @19,10 say "Die Druckdatei wird dann gespeichert" do wt ruck=.f. dr_nr = alltrim(str(dr_nr_check())) && feststellen bis && wieviel die druckdateien gehen filename="fdb_____" filename=left(filename,(8-len(dr_nr))) filename=filename+dr_nr+".prn" do lauf with 21,"Druck in Datei ---> "+filename set printer to &filename else ruck=.t. set printer to &sv_drucker endif progteil=prog_alt do progwrite return ruck * *************************************** * * * proc lauf * * noch so'n geiles ding von stefan thiemer * * im gegensatz zu cout l€uft der text * hier von links nach rechts * * parameter z - zeile in der es passiert * parameter t - der text * * * proc lauf para z,t private h,hd,ht h="" ht=0 do while len(h)<76 h=h+t+" *** " enddo do while ht=0 ht=inkey() @z,1 say left(h,78) h=right(h,len(h)-1)+left(h,1) for hd=0 to 400 &&* hier mehr wenn unlesbar next enddo @z,1 clear to z,78 keyb chr(ht) return * **************************************** * * * func syscheck() * * testet ob alle programme vorhanden sind * wenn nicht wir automatisch die letzte backup-disk * angefordert. * * * func syscheck progteil="CHECK" private ok do frame do ssc do blink do cout with 5,"Dateikontrolle" do norm do cout with 7,"€berpr€fte Dateien :" ok=isda("kuda.dbf","Kunden-Daten") ok= ok .and. isda("kindex_1.ntx","Kunden Index 1") ok= ok .and. isda("kindex_2.ntx","Kunden Index 2") ok= ok .and. isda("kuda.dbt","Bemerkungen") ok= ok .and. isda("arda.dbf","Artikel-Daten") ok= ok .and. isda("aindex_1.ntx","Artikel Index 1") ok= ok .and. isda("display.mem","Displaytreiber") ok= ok .and. isda("system.mem","Parameter-Datei") ok= ok .and. isda("print.mem","Druckertreiber") ok= ok .and. isda("d_kuda.dbf","Backup-Datei 1") ok= ok .and. isda("d_arda.dbf","Backup-Datei 2") ok= ok .and. isda("help.dbf","Hilfetexte 1") ok= ok .and. isda("help.dbt","Hilfetexte 2") ok= ok .and. isda("help.ntx","Hilfe-Index") if !ok do blink do cout with row()+2,"Dateikontrolle nicht erfolgreich" do norm endif inkey(3) clear typeahead return ok * *************************************** * * * func isda * * wird von syscheck verwendet * * auch stefan * * function isda param was,msg do cout with row()+1,msg if !file(was) do blink do cout with row(),"*** "+msg+" nicht gefunden ! ***" do norm else do hell do cout with row(),msg+" in Ordnung !" do norm endif return file(was) * *************************************** * * func memoda f€r festellung ob memofeld * voll ist * * * function memoda private ruck,dummy dummy = memoline(BEM) if !empty(dummy) ruck = .t. else ruck = .f. endif return ruck * **************************************** * * * func rlog() * * probiert den satz im netz zu sperren * function rlog if !rlock() do nachricht with "Satzsperre nicht m€glich" SOUND(err_sound) SOUND(err_sound) inkey(0) clear typeahead do nachricht endif return rlock() * * * **************************************** * * * * proc relog * * freigabe satz im netz * procedure relog unlock return * * * **************************************** * * * func flog() * * sperren dateien vor anderen schreibzugriffen * * function flog * old_dbf=alias() select 1 rueckg=.t. private rueckg * if !flock() do ssc do lauf with 10,"Kann die Kunden-Daten nicht Schreib-Sperren - ABBRUCH" rueckg=.f. endif * select 2 * if !flock() do ssc do lauf with 10,"Kann die Artikel-Daten nicht Schreib-Sperren - ABBRUCH" reuckg=.f. endif * select 3 * if !flock() do ssc do lauf with 10,"Kann die Hilfetexte nicht Schreib-Sperren - ABBRUCH" reuckg=.f. endif * select &old_dbf return rueckg * * * *************************************** * * proc kalender mit fund dw * klasse ding von stefan thiemer * function dw parameters d private h h=dow(d) return (if(h=1,h+6,h-1)) * procedure kalender PARAMETERS datum,zeile,spalte sdatum=datum Tage=" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31" @ zeile + 1, spalte CLEAR TO zeile + 10, spalte + 23 @ zeile + 1, spalte TO zeile + 10, spalte + 23 @ zeile, spalte + 2 TO zeile + 2, spalte + 21 DOUBLE @ zeile + 1, spalte + 3 CLEAR TO zeile + 1, spalte + 20 do hell @ zeile + 3, spalte + 2 SAY "Mo Di Mi Do Fr Sa So" do norm cmonat = UPPER(CMONTH(datum)) + " " + STR(YEAR(datum), 4) cmonat = STUFF(SPACE(18), (20 - LEN(cmonat)) / 2, LEN(cmonat), cmonat) wdatum = datum - DAY(datum) + 1 letzter = DAY((wdatum + 31) - DAY(wdatum + 31)) tage = SPACE((DW(wdatum) - 1) * 3) + LEFT(tage, 3 * letzter) tage = tage + SPACE(126 - LEN(tage)) do hell @ zeile + 1, spalte + 3 SAY cmonat do norm @ zeile + 4, spalte + 1 SAY LEFT(tage, 21) @ zeile + 5, spalte + 1 SAY SUBSTR(tage, 22, 21) @ zeile + 6, spalte + 1 SAY SUBSTR(tage, 43, 21) @ zeile + 7, spalte + 1 SAY SUBSTR(tage, 64, 21) @ zeile + 8, spalte + 1 SAY SUBSTR(tage, 85, 21) @ zeile + 9, spalte + 1 SAY RIGHT(tage, 21) hz=int(at(str(day(sdatum),2),tage)/21)+4 hp=at(str(day(sdatum),2),tage)%21 do inv @ zeile+hz,spalte+hp say day(sdatum) pict "99" do norm RETURN * * * *********************************************************** proc reind * * reindex der dbf's * progteil="---???---" do ssc if flog() do blink do cout with 10,"Ich baue die Indexe neu auf." do hell do cout with 13,"In der Kunden-Datei" select 1 reindex do cout with 15,"Und bei den Artikeln" select 2 reindex do cout with 17,"Und, last but not least, bei den Hilfetexte" select 3 reindex select 1 do wt endif * * * *********************************************************** *********************************************************** *********************************************************** * * * * DRUCKROUTINEN * * * Grunds€tzliches zur Druckausgabe : * * bei NORMAL - schrift geh€ren 80 zeichen in die zeile !!!! * bei FETT - schrift geh€ren 40 zeichen in die zeile !!!! * bei CONDESED-schrift geh€ren 132 zeichen in die Zeile !!! * * DAS BLATT HAT 62 ZEILEN ............ !!!!!!!!!!!!!!!!!!!! * * Variablen zur Druckersteuerung : * * dr_breit = breitschrift (ESC-SO) * dr_dh0 = * dr_dh1 = * dr_elite = * dr_eng = schmalschrift (ESC-SI) * dr_fett0 = Doppeldruck aus * dr_fett1 = Doppeldruck an * dr_init = Drucker initialisieren (bei Laser init+emulation) * dr_name = Druckername * dr_norm = Drucker Normschrift * dr_pica = sch€nschrift * * *********************************************************** *********************************************************** *********************************************************** * * proc header * * generiert den blattkopf f€r druckausgaben * * * procedure header parameter verw *** verw ist das was im kopf steht z.b. bestellung oder anfrage usw private st_4,st_8,l_4,l_8,pers_dat,sp,datum st_4=repl("*",40) && sternchen-balken st_8=repl("*",80) && sternchen-balken l_4=repl("-",40) && strich-linie l_8=repl("-",80) && strich-linie pers_dat=trim(sv_lna)+" * "+sv_lad datum=left(cdow(date()),2)+". "+dtoc(date()) pers_dat=pers_dat+" / "+bedienername+" | "+datum sp=40-(int(len(pers_dat)/2)) pers_dat=space(sp)+pers_dat ?? dr_init ?? dr_norm @ 0,0 say pers_dat ? st_8 ?? dr_fett1 @ 2,5 say left(verw,40) @ 3,0 say l_4 ?? dr_fett0 ?? dr_norm * * * *********************************************************** * *pron und proff sind zum aus- bzw einschalten der druckerausgabe *ohne bildschirmausgabe * * * procedure pron set cons off set devi to print set print on return * procedure proff set print off set devi to screen set cons on * * * *********************************************************** * * func dr_nr_check * * test ob druckdatein vorhanden sind und gibt die n€chste freie * zur€ck ( zb: wenn datein bis f€nf da sind gibts sechs zur€ck) * * function dr_nr_check private nr,filename,ende filename="fdb____1.prn" nr=1 ende=.f. do while !ende if file(filename) nr=nr+1 filename="fdb_____.prn" filename=left(filename,(8-len(alltrim(str(nr))))) filename=filename+alltrim(str(nr))+".prn" else ende=.t. endif enddo return nr ************************************************************* ************************************************************* ************************************************************* *********************************************************** * hilfe.prg * * die hilfe-datenbank f€r flex_db * * hado hein, XXXoutdatedXXXstra€XXXoutdatedXXX, 4 ddf 30 * 0211-XXXoutdatedXXX , 0161-224499 * *********************************************************** procedure help parameters prg_name, zeile, eing_var save screen to old_scr old_progteil=progteil old_row=row() old_col=col() old_farb=setcolor() old_dbf=alias() progteil="HILFE !!" select 3 such = upper(old_progteil) find &such if eof() .and. !found() h_text = "Sorry, aber es ist keine Hilfe verf€gbar..." else h_text = help->text endif do inv @ 5,1 clear to 21,78 @ 5,1 to 21,78 double @ 21,20 say "Verlassen mit " MEMOEDIT(h_text,6,3,20,77,.f.,"",73,4) progteil = old_progteil @ old_row,old_col set color to &old_farb select &old_dbf rest screen from old_scr ************************************************************************* * Funktion: GETENVPARM() * Autor: Michael Peters, Nantucket GmbH * Datum: 18.05.89 * R€ckgabe: Zeichenkette Parameterzur Environment Variablen * Anwendung: €ber diese Funktion kann der oder die Parameter zu einer * Environment Variablen ermittelt werden. * Hinweise: Diese Funktion ist toleranter als Clipper's GETE(), da * zwischen Variable und Parameter auch Blank stehen d€rfen. * * Beispiel: ? GETENVPARM("CLIPPER") && Parameter zu CLIPPER-Var. * ************************************************************************** FUNCTION GETENV PARAMETERS Variable PRIVATE Var, Pos, Par Var = UPPER(ENVPARAM()) && Environment holen Var = CHARONE(" ", Var) && Mehrfach-Blank entfernen Var = ATREPL(" =", Var, "=") && Blank vor "=" entfernen Pos = AT(Variable + "=",Var) && Die Position im Environment IF Pos > 0 && Variable gefunden? Var = SUBSTR(Var,Pos) Par = TOKEN(Var,"= " + CHR(13),2) && 2. Token -> Parameter ELSE Par = "" ENDIF RETURN(Par) ************************************************************************** * * proc upda_check * ***************** kontrolliert welche sv_var umgesetzt werden sollen * proc upda_check do case case upper(update) = "GO_FOR_IT_!" sv_shliz=.t. lizenz=.t. do lauf with 12,"Programm auf Einzelplatz-Lizenz umgestellt." case upper(update) = "ROCK_THE_SYSTEM_DOWN_!" sv_datacheck=.t. lizenz=.t. do lauf with 12,"Programm auf Netzwerk-Lizemz umgestellt." case upper(update) = "ZAUBERMEISTER" masterbed=.t. lizenz=.t. bedienername="SYSOP" endcase return ************************************************************************** procedure drget param zeile,seq,id private b,b1,i if type("seq")="U" seq="" endif declare b[10] @ zeile,3 say id for i=1 to 10 b[i]=if(i>len(seq),999,asc(substr(seq,i,1))) @ row(),30+4*i get b[i] pict "999" range 0,999 next read i=1 b1="" do while b[i]<256 b1=b1+chr(b[i]) i=i+1 enddo seq=b1 return€