********************************************************** * eD_pr * retival / neuanlegen / l€schen f€r flex_db * * (C) HADO HEIN 1991 * *********************************************************** progteil="PREISDATEI" do ssc @ 12,25 prompt " Preise editieren " @ 13,25 prompt " Preise neuanlegen " @ 14,25 prompt " Preise l€schen " private wahlli menu to wahlli do case case wahlli = 1 do preis_ed case wahlli = 2 do preis_app case wahlli = 3 .and. masterbed do preis_lo case wahlli = 3 .and. !masterbed do lauf with 16,"L€schen ist nur im SUPERVISOR-Modus m€glich" endcase return ************************************************************ * preis_app * (c) hado hein , XXXoutdatedXXXstra€XXXoutdatedXXX, 4000 d€sseldorf 30 * 0161-XXXoutdatedXXX *********************************************************** * zum neuanlegen eines kunden * ******************************* * * * procedure preis_app progteil = "Preis NEU" private n_art_nr,n_ek,n_pgru,n_bestnr,n_liefn,n_art_lief store space(6) to n_lief store space(20) to n_bestnr store space(10) to n_pgru,n_best,n_art_nr store space(16) to n_art_lief store 0 to n_ek * private ende,rueck store 1 to rueck * select preise * do ssc do hell do cout with 10,"Geben Sie bitte die Artikelnummer ein." do norm @ 12,10 say "Artikelnummer : " @ 12,30 get n_art_nr READ n_art_nr=upper(left(n_art_nr+space(10),10)) if lastkey()=27 return endif do ssc @ 12,05 say "Artikelnummer : " do hell @ 12,20 say n_art_nr do norm savee() select artikel such = n_art_nr go top seek such if !found() do lauf with 15,"Diese Artikelnummer gibt es nicht." return else @ 13,05 say "Name (1) :" @ 14,05 say "Name (2) :" do hell @ 13,16 say name1 @ 14,16 say name2 endif reste() do norm @ 15,05 say "Lieferant : " get n_lief picture "@K" READ if lastkey()=27 return endif n_lief=upper(left(n_lief+space(6),6)) if !lieflook(n_lief) do lauf with 15,"Diesen Lieferanten gibt es nicht." return endif private such go top such=trim(upper(n_art_nr+n_lief)) seek such if found() .and. upper(preise->art_lief) = n_art_nr+n_lief do lauf with 16,"Zum Artikel "+trim(n_art_nr)+; " gibt es schon einen Preis von "+trim(n_lief) return endif n_art_lief=n_art_nr+n_lief rueck = 1 do while rueck <> 2 do ssc private kopftext kopftext="Artikel : "+n_art_nr+" von "+n_lief do cout with 6,kopftext @ 8,10 say "EK :" @ 8,25 get n_ek picture "@K" @ 9,10 say "Preisgr. :" @ 9,25 get n_pgru picture "@K" @10,10 say "Bestellnr. :" @10,25 get n_bestnr picture "@K" READ * if lastkey()=27 return endif * n_pgru = left(n_pgru+space(10),10) n_bestnr = left(n_bestnr+space(20),20) * do hell @ 8,25 say n_ek picture "9999999.99" @ 9,25 say n_pgru @10,25 say n_bestnr do norm * @maxrow()-6,30 prompt "€ndern" @maxrow()-5,30 prompt " OK " @maxrow()-4,30 prompt " ENDE " menu to rueck * *Jetzt gebens wir dem benutzer mal richtig * if empty(n_pgru) .and. empty(n_ek) .and. rueck = 2 do nachricht with "Preis und Preisgruppe sind leer !" SOUND(err_sound) rueck=1 endif * if rueck = 3 return endif * enddo * * * na endlich * * select preise append blank if rlog() replace art_lief with upper(n_art_lief) replace ek with n_ek replace pgru with upper(n_pgru) replace bestnr with upper(n_bestnr) commit do relog do preis_upda endif * * * mann war das eine schwere geburt * * * return ************************************************************************** ************************************************************************** * * procedure preis_edit * * Datenpflege f€r preise.dbf in flex_best * * hado hein 1990 * ********************************************************** procedure preis_ed progteil="Preis EDITIEREN" select preise go top private felder[3],picture[3],ueber[3] felder[1] = "EK" felder[2] = "PGRU" felder[3] = "bestnr" picture[1] = "9999999.99" picture[2] = "XXXXXXXXXX" picture[3] = "XXXXXXXXXXXXXXXXXXXX" ueber[1] = " EK " ueber[2] = " Preisgr. " ueber[3] = " Bestellnummer " do ssc s_art=upper(preise->art_lief) savee() select artikel set order to 1 seek left(s_art,10) reste() @ 6,07 say left(s_art,10) + " : "+artikel->name1 @ 7,07 say "Lieferant : "+upper(right(preise->art_lief,6)) do norm @ maxrow()-7,01 to maxrow()-7,maxcol()-1 do cout with maxrow()-6,"| Return € ESC € Strg -> € Strg <- | F 10 " do cout with maxrow()-5,"| €ndern € Ende € nach € nach | Notiz- " do cout with maxrow()-4,"| € € rechts € links | Zettel" keyboard chr(32) do hell DBEDIT( 9,1,maxrow()-8,maxcol()-1,felder,"predit_func",picture,ueber,"€","€") return * * ************************************************************ * *FUNCTION predit_func * FUNC PREDIT_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 NTOC(recno()) * do norm if s_art <> preise->art_lief s_art = upper(preise->art_lief) savee() select artikel set order to 1 seek left(s_art,10) reste() @ 6,07 say left(s_art,10) +" : "+artikel->name1 @ 7,07 say "Lieferant : "+upper(right(preise->art_lief,6)) endif do hell if deleted() do nachricht with ">GEL€SCHT<" else do nachricht 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. rlog() && RETURN = Feld edit set intensity off do inv store &getfeld to agetfeld @ old_z, old_s GET agetfeld picture "@K" READ if feldind > 1 replace &getfeld with upper(agetfeld) else replace &getfeld with agetfeld 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 preis_lo f€r flex-best * * (c) hado hein * XXXoutdatedXXXstra.53 4 ddf 30 0211-XXXoutdatedXXX u. 0161-XXXoutdatedXXX * * keine verwendung des quelltextextes ohne meine zustimmung * *********************************************************** * procedure preis_lo private old_rec,ein_lief,ein_art_nr,abfrage,suche store space(2) to abfrage store space(6) to ein_lief store space(10) to ein_art_nr progteil = "Preis L€SCHEN" do ssc do hell @ 10,10 say "Bitte geben Sie die Artikelnummer und Lieferant ein." do nachricht with "Zur€ck mit ESC" @ 12,10 say "Artikelnummer : " get ein_art_nr @ 13,10 say "Lieferant : " get ein_lief READ if lastkey()=27 return endif ein_art_nr = upper(left(ein_art_nr+space(10),10)) ein_lief = upper(left(ein_lief+space(6),6)) if masterbed .and. flog() select preise suche = ein_art_nr+ein_lief seek suche if found() .and. preise->art_lief = ein_Art_nr+ein_lief do norm do preis_disp with recno() do inv do cout with maxrow()-6,"Dieser Datensatz wird mit allen Daten gel€scht !!!" do blink do cout with maxrow()-5,"Geben Sie >>>JA<<< ein zum weitermachen." do nachricht with "Zur€ck mit ESC" @ maxrow()-4,39 get abfrage READ do nachricht if lastkey()=27 return elseif abfrage <> "JA" return endif if abfrage = "JA" do ssc do cout with 15,"Ich arbeite an den Preisdaten" delete inkey(2) pack do hell do lauf with 15,"Preis ERFOLGREICH gel€scht." endif && des l€schvorganges else && wenn nicht found() usw. do ssc do hell do lauf with 15,"Diesen Preis gibt es nicht." endif && der found()-schleife endif && der ganzen arie ( masterbed/flog()/lastkey<>27 ) €