********************************************************** * edits * retival / neuanlegen / l€schen f€r flex_db * * (C) 1991 Hado Hein * *********************************************************** progteil="Datenpflege" do ssc @ 11,25 prompt " Kundendaten editieren " @ 12,25 prompt " Artikeldaten editieren " @ 13,25 prompt " Kunden neuanlegen " @ 14,25 prompt " Kunden l€schen " private wahlli menu to wahlli do case case wahlli = 1 do ed_ku case wahlli = 2 do ed_ar case wahlli = 3 do ku_app case wahlli = 4 if !masterbed do lauf with 17,; "Kunden l€schen ist nur im SUPERVISOR-Modus m€glich ! " else do lo_ku endif endcase return ************************************************************ * kund_app * (c) hado hein , XXXoutdatedXXXstra€XXXoutdatedXXX, 4000 d€sseldorf 30 * 0161-XXXoutdatedXXX *********************************************************** * zum neuanlegen eines kunden * ******************************* * * * procedure ku_app progteil = "Kunde NEU" private n_herst,n_typ,n_name,n_firma,n_strasse,n_plz,n_stadt private n_t_1,n_t_2,n_t_3,n_ansprechp,n_kennwort store space(5) to n_herst,n_plz store space(15) to n_typ store space(40) to n_firma,n_name,n_strasse store space(25) to n_t_1,n_t_2,n_t_3 store space(20) to n_ansprechp store space(10) to n_kennwort store space(30) to n_stadt * private ende,rueck store 1 to rueck * do ssc do hell do cout with 10,"Geben Sie bitte Anlagenhersteller & Typ ein." do norm @ 12,10 say "Hersteller : " @ 12,30 get n_herst @ 14,10 say "Typ : " @ 14,30 get n_typ READ if lastkey()=27 return endif * * do while rueck <> 2 do ssc do hell @ 12,10 say "Hersteller : " @ 12,30 say n_herst @ 14,10 say "Typ : " @ 14,30 say n_typ do norm * @ 17,30 prompt "€ndern" @ 18,30 prompt " OK " @ 19,30 prompt " ENDE " menu to rueck * if empty(n_herst) .or. empty(n_typ) .and. rueck = 2 do ssc do inv do cout with 15,"Beide Felder (Hersteller & Typ)" do cout with 17,"m€ssen mindestens ein Zeichen" do cout with 19,"enthalten !" do norm do wt rueck = 3 endif if rueck = 2 private n_ok,suche n_ok = .f. go top suche=trim(upper(n_typ)) set order to 2 seek suche set order to 1 if found() .and. upper(kuda->typ) = upper(n_typ) n_ok = .t. endif if n_ok do ssc do lauf with 14,"Diese Kennung gibt es schon !!!" select 1 rueck = 3 endif endif * do case case rueck = 1 n_herst=n_herst+space(5) n_typ=n_typ+space(15) n_herst=left(n_herst,5) n_typ=left(n_typ,15) @ 12,30 get n_herst picture "@K" @ 14,30 get n_typ picture "@K" READ case rueck = 2 n_herst=left(upper(n_herst)+space(5),5) n_typ=left(upper(n_typ)+space(15),15) case rueck = 3 return endcase enddo * rueck = 1 * * * und das gleiche f€r die adressdaten * * do while rueck <> 2 do ssc private kopftext kopftext="Anlage : "+trim(n_typ)+" von "+trim(n_herst) do cout with 5,kopftext @ 7,10 say "Firma :" @ 7,25 get n_firma picture "@K" @ 8,10 say "Name :" @ 8,25 get n_name picture "@K" @ 9,10 say "Strasse :" @ 9,25 get n_strasse picture "@K" @10,10 say "PLZ :" @10,25 get n_plz picture "@K" @11,10 say "Stadt :" @11,25 get n_stadt picture "@K" @12,10 say "Telefon 1 :" @12,25 get n_t_1 picture "@K" @13,10 say "Telefon 2 :" @13,25 get n_t_2 picture "@K" @14,10 say "Tel.3 / Fax:" @14,25 get n_t_3 picture "@K" @15,10 say "Anspechp. :" @15,25 get n_ansprechp picture "@K" @16,10 say "Kennwort :" @16,25 get n_kennwort picture "@K" READ * n_firma = left(n_firma+space(40),40) n_name = left(n_name+space(40),40) n_strasse = left(n_strasse+space(40),40) n_plz = left(n_plz+space(5),5) n_stadt = left(n_stadt+space(30),30) n_t_1 = left(n_t_1+space(25),25) n_t_2 = left(n_t_2+space(25),25) n_t_3 = left(n_t_3+space(25),25) n_ansprechp = left(n_ansprechp+space(20),20) n_kennwort = left(n_kennwort+space(10),10) * do hell @ 7,25 say n_firma @ 8,25 say n_name @ 9,25 say n_strasse @10,25 say n_plz @11,25 say n_stadt @12,25 say n_t_1 @13,25 say n_t_2 @14,25 say n_t_3 @15,25 say n_ansprechp @16,25 say n_kennwort do norm * if empty(n_name) .and. empty(n_firma) do lauf with 21,"Firma u n d Name sind leer" clear typeahead endif if empty(n_strasse) .and. empty(n_plz) .and. empty(n_stadt) do lauf with 21,"Es ist keine Adresse angegeben" clear typeahead endif * @18,30 prompt "€ndern" @19,30 prompt " OK " @20,30 prompt " ENDE " menu to rueck * * *Jetzt gebens wir dem benutzer mal richtig * if empty(n_name) .and. empty(n_firma) .and. empty(n_strasse); .and. empty(n_stadt) .and. rueck = 2 do nachricht with "Adressdaten eingeben !" do lauf with 21,"So nehme ich den Datensatz nicht an" rueck=1 endif * if rueck = 3 return endif * enddo * * * na endlich * * if !n_ok select 1 append blank if rlog() replace firma with n_firma replace name with n_name replace strasse with n_strasse replace plz with n_plz replace stadt with n_stadt replace t_1 with n_t_1 replace t_2 with n_t_2 replace t_3 with n_t_3 replace ansprechp with n_ansprechp replace kennwort with n_kennwort replace herst with upper(n_herst) replace typ with upper(n_typ) commit do relog endif endif * * * mann war das eine schwere geburt * * * return ************************************************************************** ************************************************************************** ************************************************************************** * * procedure ed_ku * * Datenpflege f€r flex_db * * hado hein 1990 * ********************************************************** * * * procedure ed_ku progteil = "Kunden-Datenpfelge" select 1 do ssc go top do dbed_ku return * * * * * * procedure dbed_ku private felder[12],picture[12],ueber[12] felder[1] = "FIRMA" felder[2] = "NAME" felder[3] = "STRASSE" felder[4] = "PLZ" felder[5] = "STADT" felder[6] = "T_1" felder[7] = "T_2" felder[8] = "T_3" felder[9]= "ANSPRECHP" felder[10]= "KENNWORT" felder[11]= "HERST" felder[12]= "TYP" picture[1] = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" picture[2] = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" picture[3] = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" picture[4] = "XXXXX" picture[5] = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" picture[6] = "XXXXXXXXXXXXXXXXXXXXXXXXX" picture[7] = "XXXXXXXXXXXXXXXXXXXXXXXXX" picture[8] = "XXXXXXXXXXXXXXXXXXXXXXXXX" picture[9]= "XXXXXXXXXXXXXXXXXXXX" picture[10]= "XXXXXXXXXX" picture[11]= "XXXXX" picture[12]= "XXXXXXXXXXXXXXX" ueber[1] = " Firma " ueber[2] = " Name " ueber[3] = " Strasse " ueber[4] = " PLZ " ueber[5] = " Stadt " ueber[6] = " Telefon 1 " ueber[7] = " Telefon 2 " ueber[8] = " Telefon 3 / Fax " ueber[9]= " Ansprechpartner " ueber[10]= " Kennwort " ueber[11]= "Herst" ueber[12]= " Kennung " do ssc do norm @ 18,01 to 18,78 do cout with 19,"| Return € ESC € Strg -> € Strg <- | F 10 " do cout with 20,"| €ndern € Ende € nach € nach | Notiz- " do cout with 21,"| € € rechts € links | Zettel" keyboard chr(32) do hell DBEDIT( 5,1,16,78,felder,"ed_ku_func",picture,ueber,"€","€") return * * * * * * * ************************************************************ * * * *FUNCTION edifunc * * wird f€r dbedit * * * FUNC ED_ku_FUNC PARAMETERS modus, feldind PRIVATE getfeld,agetfeld getfeld = felder[feldind] && €bernahme d. aktuellen Feldes rueck = 1 old_s = COL() old_z = ROW() * do norm @ 00,01 to 00,08 double do hell @ 00,01 say alltrim(str(recno())) * * if deleted() do nachricht with ">GEL€SCHT<" do hell else do nachricht do hell endif * * do norm private arec select 2 if eof() do inv @ 17,20 say " K E I N E Daten vorhanden " do hell else @ 17,20 say " " endif select 1 do hell DO CASE CASE modus = 1 && Dateianfang erreicht go top SOUND(warn_sound) do nachricht with "Dateianfang erreicht" inkey(1) do nachricht do hell rueck = 2 CASE modus = 2 && Dateiende erreicht go bottom SOUND(warn_sound) do nachricht with "Dateiende erreicht" inkey(1) do nachricht do hell rueck = 2 CASE LASTKEY() = 13 .and. masterbed .and. rlog() && RETURN = Feld edit set intensity off do inv store &getfeld to agetfeld @ old_z, old_s GET agetfeld picture "@K" READ if ke[feldind] replace &getfeld with agetfeld endif if !ke[feldind] .and. empty(agetfeld) SOUND(err_sound) do nachricht with "Leer geht nicht !" inkey(1) do nachricht elseif !ke[feldind] .and. !empty(agetfeld) replace &getfeld with agetfeld endif do hell set intensity on @ old_z, old_s say &getfeld keyboard chr(24) rueck = 1 CASE LASTKEY() = 13 .and. ke[feldind]; && RETURN = Feld editieren .and. rlog() set intensity off do inv store &getfeld to agetfeld @ old_z, old_s GET agetfeld picture "@K" READ if !empty(agetfeld) replace &getfeld with agetfeld else SOUND(warn_sound) do nachricht with "Leer geht nicht !" inkey(1) endif do hell @ old_z,old_s say &getfeld set intensity on keyboard chr(24) rueck = 1 CASE LASTKEY() = 13 .and. !ke[feldind]; && RETURN = Feld editieren SOUND(err_sound) do nachricht with "€ndern nicht zugelassen" inkey(1) do nachricht do hell rueck = 1 CASE LASTKEY() = 27 && ESC = DBEDIT() beenden rueck = 0 CASE LASTKEY() = -9 && M E M O E D I T save screen to sicher do memedit clear typeahead rest screen from sicher keyboard chr(24) rueck = 2 ENDCASE do relog RETURN rueck * * ************************************************************************** ************************************************************************** ************************************************************************** * * procedure ed_ar * * Datenpflege f€r flex_db * * hado hein 1990 * ********************************************************** * * * procedure ed_ar progteil = "Artikel-Datenpfelge" select 2 if eof() go top endif private felder[11],picture[11],ueber[11] felder[1]="TYP" felder[2]="DATUM" for i = 1 to 9 felder[(i+2)]="AD"+str(i,1,0) next for i = 1 to 11 picture[i]=ap[i] ueber[i]=au[i] next do ssc do hell a_typ=typ o_rec = recno() select 1 set order to 2 find &a_typ a_typ=typ set order to 1 store space(20) to na,fi,ansp na=left(name,20) fi=left(firma,20) ansp=left(ansprechp,20) ausgab=fi+" € "+na+" € "+ansp @ 5,10 say ausgab select 2 go o_rec do norm @ 18,01 to 18,78 @ 19,18 say "| Return € ESC € Strg -> € Strg <- |" @ 20,18 say "| €ndern € Ende € nach € nach |" @ 21,18 say "| € € rechts € links |" keyboard chr(32) do hell DBEDIT( 7,1,17,78,felder,"ed_ar_func",picture,ueber,"€","€") select 1 return * * * * * * * ************************************************************ * * * *FUNCTION edifunc * * wird f€r dbedit * * * FUNC ED_AR_FUNC PARAMETERS modus, feldind PRIVATE getfeld,agetfeld getfeld = felder[feldind] && €bernahme d. aktuellen Feldes rueck = 1 old_s = COL() old_z = ROW() * * do norm @00,01 to 00,08 double do hell @ 00,01 say alltrim(str(recno())) * if a_typ <> arda->typ a_typ=arda->typ o_rec = recno() select 1 set order to 2 find &a_typ set order to 1 store space(20) to na,fi,ansp na=left(name,20) fi=left(firma,20) ansp=left(ansprechp,20) ausgab=fi+" € "+na+" € "+ansp @ 5,10 say ausgab select 2 go o_rec endif if deleted() do nachricht with ">GEL€SCHT<" do hell else do nachricht do hell endif * * do hell DO CASE CASE modus = 1 && Dateianfang erreicht go top SOUND(warn_sound) do nachricht with "Dateianfang erreicht" inkey(1) do nachricht do hell rueck = 2 CASE modus = 2 && Dateiende erreicht go bottom SOUND(warn_sound) do nachricht with "Dateiende erreicht" inkey(1) do nachricht do hell rueck = 2 CASE LASTKEY() = 13 .and. masterbed .and. rlog() && RETURN = Feld editieren set intensity off do inv store &getfeld to agetfeld @ old_z, old_s GET agetfeld picture "@K" READ * obwohl der masterbediener eigentlich immer * immer aufpassen sollte, kann er * felder die auf ae=.f. gesetzt sind * nicht auf leer €ndern. * * ist daf€r da, weil €ber diese felder * ja die relation gesetzt ist * * schon schlimm genug, das er so felder * in die ewigen jagdgr€nde schicken kann. * * wenn er jetzt hier etwas €ndert was es in * kuda nicht gibt, wird dieser satz immer * drin bleiben, obwohl er nicht mehr zu gebrauchen * ist. * if ae[feldind] replace &getfeld with agetfeld endif if !ae[feldind] .and. !empty(agetfeld) replace &getfeld with agetfeld elseif !ae[feldind] .and. empty(agetfeld) SOUND(err_sound) do nachricht with "Leer geht nicht !" inkey(1) endif do hell set intensity on @ old_z, old_s say &getfeld keyboard chr(24) rueck = 1 CASE LASTKEY() = 13 .and. !ae[feldind] && RETURN = Feld editieren SOUND(err_sound) do nachricht with "€ndern nicht zugelassen" inkey(1) do nachricht do hell rueck = 1 CASE LASTKEY() = 13 .and. ae[feldind] .and. rlog() && RETURN = Feld edit set intensity off do inv store &getfeld to agetfeld @ old_z, old_s GET agetfeld picture "@K" READ if !empty(agetfeld) replace &getfeld with agetfeld else SOUND(warn_sound) do nachricht with "Leer geht nicht !" inkey(1) endif do hell @ old_z,old_s say &getfeld set intensity on keyboard chr(24) rueck = 1 CASE LASTKEY() = 27 && ESC = DBEDIT() beenden rueck = 0 ENDCASE do relog RETURN rueck ************************************************************************** ************************************************************************** ************************************************************************** * * proc lo_ku f€r flex-db * * (c) hado hein * XXXoutdatedXXXstra.53 4 ddf 30 0211-XXXoutdatedXXX u. 0161-XXXoutdatedXXX * * keine verwendung des quelltextextes ohne meine zustimmung * * * *********************************************************** * * vorgang : * * kunden aus kuda suchen * typ + herst speichern * in arda alle s€tze suchen und deleten * alle deleted()=.t. aus arda ausdrucken * --- ohne ausdruck geht's nicht weiter * "L€SCHEN" eingeben lassen * kopieren alle deleted()=.t. in d_arda und PACKen * kopieren aus kuda nach d_kuda * adressen auf deleted()=.t. setzen und PACKen * reindex * * nur masterbed=.t. and flog()=.t. * *********************************************************** procedure lo_ku private old_rec,ein_l,abfrage,suche store space(2) to abfrage store space(15) to ein_l progteil = "L€SCHEN" do ssc do hell @ 10,10 say "Bitte geben Sie die Anlagenkennung ein." do nachricht with "Zur€ck mit ESC" @ 15,10 get ein_l READ if lastkey()=27 return endif if masterbed .and. flog() set order to 2 suche=upper(ein_l) seek suche set order to 1 if found() .and. upper(kuda->typ) = upper(ein_l) old_rec=recno() do norm do ku_disp do inv do cout with 16,"Dieser Datensatz wird mit allen Daten gel€scht !!!" do blink do cout with 18,"Geben Sie >>>JA<<< ein zum weitermachen." do nachricht with "Zur€ck mit ESC" @ 19,39 get abfrage READ do nachricht if lastkey()=27 return elseif abfrage <> "JA" return endif if abfrage = "JA" do ssc do cout with 5,"Ich €ffne die Backup-Dateien." select 4 use d_kuda EXCLUSIVE if neterr() do blink do cout with row()+1,; "d_kuda - EXCLUSIVES €ffnen nicht m€glich !" do hell do lauf with row()+1," A B B R U C H " return endif select 5 use d_arda EXCLUSIVE if neterr() do blink do cout with row()+1,; "d_arda - EXCLUSIVES €ffnen nicht m€glich !" do hell do lauf with row()+1," A B B R U C H " return endif do norm set deleted off select 1 go old_rec do cout with row()+1,"Ich arbeite an den Kundendaten" delete select 2 do cout with row()+1,"Ich arbeite an den Artikeldaten" delete all for upper(arda->typ) = upper(ein_l) select 4 do cout with row()+1,"Ich kopiere die Kundendaten" appe from kuda all for deleted() select 5 do cout with row()+1,"Ich kopiere die Artikeldaten" appe from arda all for deleted() select 4 do cout with row()+1,"Backup-Dateien werden wieder geschlossen." close select 5 close inkey(2) select 1 pack select 2 pack select 1 set deleted on do reind && reindex von beiden dateien progteil = "L€SCHEN" do ssc do hell do lauf with 15,"Kunde ERFOLGREICH gel€scht." endif && des l€schvorganges else && wenn nicht found() usw. do ssc do hell do lauf with 15,"Diese Kennung gibt es nicht." endif && der found()-schleife endif && der ganzen arie ( masterbed/flog()/lastkey<>27 ) *********************************************************** * * memedit f€r flex_db * * editieren des memofeldes * * (C) hado hein, XXXoutdatedXXXstra€XXXoutdatedXXX, 4000 d€sseldorf 30 * 0161-XXXoutdatedXXX * * *********************************************************** procedure memedit old_pt=progteil progteil="NOTIZBLOCK" old_rec=recno() do ssc do inv @ 10,09 to 21,72 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,11,11,20,71,.t.,"mfunc",60,5) if rlog() replace bem with bemtext do relog endif progteil=old_pt go old_rec 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 @ 21,60 say iif(readinsert()," EINF€GEN ","€BERSCHR. ") do hell do case case modus > 0 if taste = 22 do inv @ 21,60 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€