home *** CD-ROM | disk | FTP | other *** search
/ Best of German Only 1 / romside_best_of_german_only_1.iso / anwender / zephyr / zephyr4s.2 / BEISPIEL.EXE / lha / SUCHEA.PRG < prev    next >
Text File  |  1991-02-07  |  5KB  |  178 lines

  1.  
  2. * SucheA.PRG
  3. * Programm zur Eingabe und Suche von Begriffen
  4. **************
  5.  
  6. SET TALK OFF
  7. CLEAR
  8.   DO WHILE .T.
  9.        IF LEN(TRIM(GanzNeu)) = 0
  10.           DO Wahl
  11.        ELSE
  12.           Mbegriff = "Kunden-Nr."
  13.        ENDIF
  14.      DO Init
  15.      DO SuchEin
  16.      PRIVATE Msuchdbf,Msuch,Msuchtyp,Mbegriff,Meingabe
  17.      RETURN
  18.   ENDDO
  19.  
  20. *───────────────────────────────────────────────────────────────────────────────
  21. PROCEDURE Wahl
  22. ******************
  23.  
  24. DEACTIVATE WINDOW ALL
  25. CLEAR
  26. @ 6,27 SAY "AUSWAHL DER SUCH-KRITERIEN"
  27. DEFINE WINDOW SuchEin FROM 8,27TO 12,53 DOUBLE COLOR W+/N,N/GB,GR+/GB
  28. ACTIVATE WINDOW SuchEin
  29. DEFINE MENU WAHLMENU
  30. DEFINE PAD PAD1 OF WAHLMENU PROMPT "Kunden-Nr." AT 1, 2
  31. ON SELECTION PAD PAD1 OF WAHLMENU DO PadWahl
  32. DEFINE PAD PAD2 OF WAHLMENU PROMPT "Auftrag-Nr." AT 1,13
  33. ON SELECTION PAD PAD2 OF WAHLMENU DO PadWahl
  34. ACTIVATE MENU WahlMenu
  35. RETURN
  36.  
  37. *───────────────────────────────────────────────────────────────────────────────
  38. PROCEDURE PadWahl
  39. ****************
  40. ** Hier werden den einzelnen Menü-Punkten (Pads) die entsprechenden
  41. ** Aktionen zugewiesen
  42.  
  43.   DO CASE
  44.      CASE "PAD1" = PAD()
  45.           Mbegriff = "Kunden-Nr."
  46.      CASE "PAD2" = PAD()
  47.           Mbegriff = "Auftrag-Nr."
  48.   ENDCASE
  49. SET MESSAGE TO
  50. DEACTIVATE MENU
  51. RETURN
  52.  
  53. *───────────────────────────────────────────────────────────────────────────────
  54. **************
  55. PROCEDURE Init
  56. **************
  57. * Prozedur zur Einstellung der Suchbegriffe - und Datei
  58.  
  59.   DO CASE
  60.      CASE Mbegriff = "Kunden-Nr."  && Wenn Suche von Kunden-Nr. gewählt wurde..
  61.           SELECT 1
  62.           USE ADRESSEN INDEX ADRESSEN ALIAS ADRESSEN
  63.           SET ORDER TO KDNR
  64.           Msuchdbf = "ADRESSEN"
  65.           Msuch = "KDNR"
  66.           Msuchtyp = "N"
  67.           Meingabe = SPACE( 5)
  68.           Mrelation = "KDNR"
  69.           SET FIELDS TO kdnr,name,ort
  70.      CASE Mbegriff = "Auftrag-Nr."  && Wenn Suche von Auftr.Nr gewählt wurde...
  71.           SELECT 1
  72.           USE auftrag INDEX auftrag ALIAS auftrag
  73.           SET ORDER TO AUFUNI
  74.           Msuchdbf = "AUFTRAG"
  75.           Msuch = "AUFTRNR"
  76.           Msuchtyp = "N"
  77.           Meingabe = SPACE( 5)
  78.           Mrelation = "AUFTRNR"
  79.           SET FIELDS TO auftrnr,kdnr
  80.  ENDCASE
  81.  
  82. *───────────────────────────────────────────────────────────────────────────────
  83. *****************
  84. PROCEDURE SUCHEIN
  85. *****************
  86. DEACTIVATE WINDOW ALL
  87. CLEAR
  88.   IF LEN(TRIM(Mbegriff)) = 0
  89.      RETURN TO MASTER
  90.   ENDIF
  91. @ 6,25 SAY "EINGABE DES GESUCHTEN BEGRIFFES"
  92.   IF GanzNeu = "*"
  93.      ?? CHR(7)
  94.      @ 14,20 SAY "BEI NEUEM AUFTRAG NUR KUNDEN-NUMMER MÖGLICH!"
  95.   ENDIF
  96. LenE = len(Meingabe) + len(Mbegriff) + 15
  97.   IF LenE < len(Mbegriff) + 34
  98.      LenE = len(Mbegriff) + 34
  99.   ENDIF
  100. Lstart = 40-(LenE/2)
  101. Lende = Lstart + LenE
  102. DEFINE WINDOW SuchEin FROM 8,Lstart TO 12,Lende DOUBLE COLOR W+/N,N/GB,GR+/GB
  103. ACTIVATE WINDOW SuchEin
  104.  
  105. SELECT &MSuchDbf
  106. Xeingabe = Meingabe
  107. DO WHILE .T.
  108.    set exact off
  109.    Meingabe = Xeingabe
  110.    clear
  111.    @ 1,2 say Mbegriff + " eingeben:" get Meingabe MESSAGE "Liste:(Return) - Abbruch:(Esc)"
  112.    read
  113.      IF READKEY() = 12 .OR. READKEY() = 127
  114.         DEACTIVATE WINDOW ALL
  115.         RETURN TO MASTER
  116.      ENDIF
  117.    Meingabe = ltrim(trim(Meingabe))
  118.      IF Msuchtyp = "N"
  119.         Meingabe = val(Meingabe)
  120.      ENDIF
  121.      IF Meingabe = 0
  122.         GO TOP
  123.      ELSE
  124.         seek Meingabe
  125.      ENDIF
  126.     IF EOF()
  127.        clear
  128.        @ 1,2 say Mbegriff + " NICHT gefunden. - eine TASTE!"
  129.          DO WHILE INKEY() = 0
  130.          ENDDO
  131.     ELSE
  132.        Mrecno = RECNO()
  133.        EXIT
  134.     ENDIF
  135. ENDDO
  136. SET MESSAGE TO "Blättern:(" + CHR(24) + CHR(25) + ") - Bestätigen:(Esc)"
  137. DEACTIVATE WINDOW ALL
  138. DEFINE WINDOW Brow FROM 1,50 TO 20,79 DOUBLE COLOR W+/N,N/GB,GR+/GB
  139. ACTIVATE WINDOW Brow
  140. BROWSE NOEDIT NOMENU NOAPPEND NOCLEAR
  141. SET FIELDS TO
  142. MMwst = mwst
  143. MkdNr = kdnr
  144. X_KdNr = kdnr
  145. Mrecno = RECNO()
  146. RelFeld = &Mrelation.
  147.  IF Mbegriff = "Auftrag-Nr."
  148.     MAuftrNr = auftrnr
  149.  ENDIF
  150. SET FIELDS TO
  151.   IF LEN(TRIM(GanzNeu)) = 0
  152.       IF ALIAS() # "AUFTRAG"
  153.          SELECT 9
  154.          USE AUFTRAG INDEX Auftrag ALIAS AUFTRAG
  155.       ENDIF
  156.     SELECT AUFTRAG
  157.     SET ORDER TO KdNr
  158.     SEEK MkdNr
  159.       IF Mbegriff = "Auftrag-Nr."
  160.          LOCATE NEXT 100 FOR auftrnr = MAuftrNr
  161.       ENDIF
  162.       IF .NOT. FOUND()
  163.          GanzNeu = "*"
  164.       ELSE
  165.          SET ORDER TO KdnrAuf
  166.          DEFINE WINDOW AufBrow FROM 1,20 TO 20,49 COLOR W+/N,N/GB,GR+/GB
  167.          ACTIVATE WINDOW AufBrow
  168.          BROWSE FIELDS kdnr,auftrnr,auftrdat NOEDIT NOMENU NOAPPEND NOCLEAR
  169.          X_Kdnr = kdnr
  170.          X_AuftrNr = auftrnr
  171.       ENDIF
  172.     USE
  173.   ENDIF
  174. SET FIELDS TO
  175. DEACTIVATE WINDOW ALL
  176. CLEAR
  177. RETURN
  178.