*************************************** * * dies ist die prcedure und function * sammlung f€r ??? * * (C) hado hein 1991 * * 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. * * *************************************** * * Hier ist die guten-tag-sagen-proc * * proc 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 artikel 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=(maxcol()/2)-int(len(t)/2) iif(sp=0,sp=1,sp=sp) @ r,sp say left(t,maxcol()-2) &&* oder zu lang sein ... return * *************************************** * * * nachricht ist die proc um in der maxcol()-2 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("€",maxcol()) &&* zeile einfach l€schen else &&* msg=msg+" "+repl("€",maxcol()) &&* auff€llen endif &&* voll geil ehy @ maxrow()-2,14 clear to maxrow()-2,maxcol()-1 do hell @ maxrow()-2,14 say left(msg,maxcol()-15) do norm * * in der letzten zeile steht immer der programmteil * var progteil ist ja hoffentlich immer definiert * private textline store space(20) to textline textline=upper(progteil)+textline @ maxrow()-1,maxcol()-19 clear to maxrow()-1,maxcol()-1 do inv @ maxrow()-1,maxcol()-19 say left(textline,18) do norm return * *************************************** * * frame baut den €u€eren rahmen f€r den monitor * auf. * * proc frame do norm clear @ 0,0 to maxrow(),maxcol() double @ 2,1 to 2,maxcol()-1 if masterbed &&* irgendwie mu€ man den modus ja do inv &&* darstellen. hauptsache man wei€ end &&* das man drin ist. do cout with 1," XXXXXXXXX f€r "+upper(trim; (sv_lna))+" " do norm &&* falls inv an dann wieder aus sonst &&* verschwendeter prg-code @ 4,1 to 4,maxcol()-1 double @ maxrow()-3,1 to maxrow()-3,maxcol()-1 double @ maxrow()-2,2 say "Nachricht :" do ssc do norm return * *************************************** * * * * proc ssc ist daf€r da den normalen programm- * arbeitsbereich zu l€schen und progwrite * * * proc ssc do norm @5,1 clear to maxrow()-4,maxcol()-1 * jetzt bauen wir * uns mal einen textstring private textline store dtoc(date())+" Bediener : "+upper(Bedienername)+; +"/"+alltrim(netname())+; " " to textline do cout with 3,textline 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 = NTOC(dr_nr_check()) && feststellen bis && wieviel die druckdateien gehen filename="prn_____" filename=left(filename,(8-len(dr_nr))) filename=filename+dr_nr+".prn" do lauf with maxrow()-4,"Druck in Datei ---> "+filename set printer to &filename else ruck=.t. set printer to &sv_drucker endif progteil=prog_alt do nachricht 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) maxrow()-5 @ 5,1 endif 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) inkey(0) clear typeahead do nachricht endif return rlock() * * * **************************************** * * * * proc relog * * freigabe satz im netz * proc relog unlock return * * * **************************************** * * * func flog() * * sperren dateien vor anderen schreibzugriffen * * function flog private willy * old_row=row() old_col=col() old_dbf=alias() save screen to willy rueckg=.t. private rueckg select artikel * if !flock() SOUND(err_sound) do lauf with 10,"Kann die Artikel-Daten nicht Schreib-Sperren - ABBRUCH" rueckg=.f. endif * select preise * if !flock() SOUND(err_sound) do lauf with 10,"Kann die Preis-Daten nicht Schreib-Sperren - ABBRUCH" reuckg=.f. endif * select pg * if !flock() SOUND(err_sound) do lauf with 10,"Kann die Preisgruppen nicht Schreib-Sperren - ABBRUCH" reuckg=.f. endif * select liefera * if !flock() SOUND(err_sound) do lauf with 10,"Kann die Lieferanten-Daten nicht Schreib-Sperren - ABBRUCH" rueckg=.f. endif * select help * if !flock() SOUND(err_sound) do lauf with 10,"Kann die Hilfetexte nicht Schreib-Sperren - ABBRUCH" rueckg=.f. endif * select &old_dbf @old_row,old_col rest screen from willy * return rueckg * * * *************************************** * * proc kalender mit func dw * klasse ding von stefan thiemer * function dw parameters d private h h=dow(d) return (if(h=1,h+6,h-1)) * proc 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 inv do cout with 10,"Ich baue die Indexe neu auf." do hell do cout with 12,"Artikel - Datei" select artikel reindex do cout with 13,"Lieferanten : Preis - Datei" select preise reindex do cout with 14,"Lieferanten : Preisgruppen - Datei" select pg reindex do cout with 15,"Lieferanten : Adressen - Datei" select liefera reindex do cout with 16,"Hilfetxte" select help 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 * * * proc 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 ? left(verw,40) ? l_4 ?? dr_fett0 ?? dr_norm * * * *********************************************************** * *pron und proff sind zum aus- bzw einschalten der druckerausgabe *ohne bildschirmausgabe * * * proc pron set cons off set devi to print set print on return * proc 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="prn_____.prn" filename=left(filename,(8-len(alltrim(str(nr))))) filename=filename+alltrim(str(nr))+".prn" else ende=.t. endif enddo return nr ************************************************************* ************************************************************* ************************************************************* * hilfe.prg * *********************************************************** proc 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 help 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 maxrow()-4,maxcol()-1 @ 5,1 to maxrow()-4,maxcol()-1 double do cout with maxrow()-4," Verlassen mit | PgUp / PgDwn zum Bewegen " MEMOEDIT(h_text,6,3,maxrow()-5,maxcol()-2,.f.,"",maxcol()-6,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 save to system all like sv_* return ************************************************************************** * * func savee() und reste() - save und restore enviornment * function savee parameter egal egal=.t. public oldrow,oldcol,oldfar,olddbf,oldrec,oldpro oldrow=row() oldcol=col() oldfar=setcolor() olddbf=alias() oldrec=recno() oldpro=progteil return egal function reste parameter egal egal=.t. row()=oldrow col()=oldcol set color to &oldfar select &olddbf go oldrec progteil=oldpro return egal ************************************************************************** * * ed_memo zum editieren des memofeldes * * para recno(),datei * ************************************************************************** procedure ed_memo parameter rec,datei savee() save screen to wutz set cursor on select &datei go rec progteil="NOTIZBLOCK" do ssc do inv @ 09,01 to maxrow()-4,maxcol()-1 DOUBLE do norm do cout with 5,"Pfeiltasten - Ein Zeichen | Ctrl-Y - Zeile l€schen" do cout with 7,"Home - Anfang Zeile | End - Zeile Ende" do cout with 6,"Ctrl <- WORT Links | Ctrl -> WORT Rechts" do cout with 8,"Ctrl Home / Ctrl End - Anfang / Ende Notiz-Zettel" do nachricht with "ENDE " do hell bemtext=MEMOEDIT(BEM,10,02,maxrow()-5,maxcol()-2,.t.,"mfunc",maxcol()-4,4) if rlog() replace bem with bemtext do relog endif rest screen from wutz reste() clear typeahead return *********************************************************** * herrlich , ich liebe'n diesen schei€ *********************************************************** function mfunc parameters modus,z,sp private rg rg = 0 * * rg = rueckgabewert * z = zeile * sp = spalte * taste=lastkey() do inv @ maxrow()-4,03 say iif(readinsert()," EINF€GEN "," €BERSCHR.") do hell do case case modus > 0 if taste = 22 do inv @ maxrow()-4,03 say iif(readinsert()," €BERSCHR."," EINF€GEN ") rg = 22 do hell endif case modus = 3 readinsert = .f. endcase if taste = 27 rg = 23 endif return rg ************************************************************************** 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€