************************************************************ * pg_app -> preisgruppe append * (c) hado hein 1991 *********************************************************** * zum neuanlegen einer preisgruppe * ************************************ * * * procedure pg_app progteil = "Preisgruppe NEU" private n_lief,n_pgru,n_ek store space(6) to n_lief store space(10) to n_pgru store 0 to n_ek * private ende,rueck store 1 to rueck * select pg * do ssc do hell do cout with 09,"Geben Sie bitte LIEFERANTENK€RZEL" do cout with 10,"und PREISGRUPPE ein." do norm @ 12,10 say "Lieferant : " @ 12,30 get n_lief @ 14,10 say "Preisgruppe : " @ 14,30 get n_pgru READ if lastkey()=27 return endif * * do while rueck <> 2 do ssc do hell @ 12,10 say "Lieferant : " @ 12,30 say n_lief @ 14,10 say "Preisgruppe : " @ 14,30 say n_pgru do norm * @ maxrow()-6,30 prompt "€ndern" @ maxrow()-5,30 prompt " OK " @ maxrow()-4,30 prompt " ENDE " menu to rueck * if empty(n_lief) .or. empty(n_pgru) .and. rueck = 2 do inv do cout with maxrow()-6,"Beide Felder (Hersteller & Typ)" do cout with maxrow()-5,"m€ssen mindestens ein Zeichen" do cout with maxrow()-4,"enthalten !" do norm do wt rueck = 3 endif if rueck = 2 private n_ok,suche n_ok = .f. go top n_lief=upper(left(n_lief+space(6),6)) n_pgru=upper(left(n_pgru+space(10),10)) suche=n_lief+n_pgru seek suche if found() .and. upper(pg->lief+pg->pgru) =; upper(n_lief+n_pgru) n_ok = .t. endif if n_ok do ssc do lauf with 16,"Diese Kennung gibt es schon !!!" rueck = 3 endif endif * do case case rueck = 1 n_lief=n_lief+space(6) n_pgru=n_pgru+space(10) n_lief=left(n_lief,6) n_pgru=left(n_pgru,10) @ 12,30 get n_lief picture "@K" @ 14,30 get n_pgru picture "@K" READ case rueck = 2 n_lief=left(upper(n_lief)+space(6),6) n_pgru=left(upper(n_pgru)+space(10),10) case rueck = 3 return endcase enddo * rueck = 1 * * * do while rueck <> 2 do ssc private kopftext kopftext="Lieferant : "+trim(n_lief)+" / "+n_pgru) do cout with 6,kopftext @ 8,10 say "EK :" @ 8,25 get n_ek picture "@K" READ * do hell @ 8,25 say n_ek picture "9999999.99" do norm * @maxrow()-6,30 prompt "€ndern" @maxrow()-5,30 prompt " OK " @maxrow()-4,30 prompt " ENDE " menu to rueck * if rueck = 3 return endif * enddo * * * na endlich * * if !n_ok select pg append blank if rlog() replace lief with upper(n_lief) replace pgru with upper(n_pgru) replace ek with n_ek commit do relog ************************************** PREISE UPDATE * aus pg die neuen ek's holen * und tauschen !!!! endif endif * * * mann war das eine schwere geburt * * * return ************************************************************************** ************************************************************************** * * procedure pg_ed * * Datenpflege f€r flex_best -> dbedit pg * * hado hein 1990 * ********************************************************** * * * procedure pg_ed select pg private felder[3],picture[3],ueber[3] felder[1] = "LIEF" felder[2] = "PGRU" felder[3] = "EK" picture[1] = "XXXXXX" picture[2] = "XXXXXXXXXX" picture[3] = "9999999.99" ueber[1] = "Lief." ueber[2] = " Preisgr. " ueber[3] = " EK " do ssc 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( 5,1,maxrow()-8,maxrow()-1,felder,"ed_pg_func",picture,ueber,"€","€") return * * * * * * * ************************************************************ * * * *FUNCTION edifunc * * wird f€r dbedit * * * FUNC ED_pg_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()) * * if deleted() do nachricht with ">GEL€SCHT<" else do nachricht endif * * private arec 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 feldind > 2 replace &getfeld with agetfeld endif if feldind < 3 .and. empty(agetfeld) SOUND(err_sound) do nachricht with "Leer geht nicht !" inkey(1) do nachricht elseif feldind < 3 .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. feldind > 2; && 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. feldind < 3 && 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 ed_memo with recno(),alias() clear typeahead rest screen from sicher keyboard chr(24) rueck = 2 ENDCASE do relog RETURN rueck * * ************************************************************************** ************************************************************************** * * proc pg_lo -> preisgruppe l€schen * * (c) hado hein * XXXoutdatedXXXstra.53 4 ddf 30 0211-XXXoutdatedXXX u. 0161-XXXoutdatedXXX * * keine verwendung des quelltextextes ohne meine zustimmung * * * *********************************************************** * procedure pg_lo private old_rec,ein_l,abfrage,suche store space(2) to abfrage store space(15) to ein_l,ein_pgru progteil = " PG - L€SCHEN" do ssc do hell @ 10,10 say "Bitte geben Sie die Lieferantenk€rzel und Preisgruppe ein." do nachricht with "Zur€ck mit ESC" @ 12,10 say "Lieferant : " @ 13,10 say "Preisgruppe :" @ 12,30 get ein_lief @ 13,20 get ein_pgru READ ein_lief = upper(left(ein_lief+space(6),6)) ein_pgru = upper(left(ein_pgru+space(10),10)) if lastkey()=27 return endif if masterbed .and. flog() select pg set order to 1 suche=ein_lief+ein_pgru seek suche if found() .and. upper(pg->lief+pg->pgru) = ein_lief+ein_pgru old_rec=recno() do norm ****************************** do pg_disp ***********PROGRAMMIEREN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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 go old_rec do cout with 15,"Ich arbeite an den Preisgruppen" delete inkey(2) pack 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 ) €