home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR7 / FOXTAILS.ZIP / LOOKUP.PRG < prev    next >
Text File  |  1992-03-21  |  6KB  |  168 lines
  1. PROCEDURE Lokup
  2. PARAMETER Ttlstr,Fldlist,Defsrch,Toprow,Topcol,botrow,;
  3. Botcol,Db,Ldb,Exwin,key1,key2
  4. *    TtlStr = String for Title Line
  5. *    Fldlist = Browse Field List in FoxPro Format
  6. *    Defsrch = Beginning Default Search
  7. *    Toprow = Top Row (relative) of Box
  8. *    Topcol = Top Column (relative) of Box
  9. *    Botrow = Bottom Row (relative) of Box
  10. *    Botcol = Bottom Column (relative) of Box
  11. *    db = Database Alias to be in use after lookup
  12. *    ldb = Database Alias to be in use during lookup
  13. *    Exwin = Window to activate upon exit
  14. *    Key1 = For Scoping (limiting) the scroll... Beginning value of index
  15. *    Key2 = For Scoping (limiting) the scroll... Ending value of index
  16.  
  17. SELECT (Ldb)        &&    Select the lookup Database
  18. *    Numlkp is a counter/macro, used for nesting these buggers.
  19. Numlkp = ALLTRIM(STR(VAL(NumLkp)+1))    &&    Only increment when needed
  20. PUSH KEY
  21. DO Keyset
  22. PRIVATE Cursrch, Newtop, Dne, Lk, Mkey, Lk_ind, Lk_sk, Lk_pct
  23. PRIVATE Osrch, Keyprg
  24. Cursrch=Defsrch        &&    Cursrch is the key for the power seek
  25. SET CONFIRM OFF
  26. SET NEAR ON
  27. SET EXACT OFF
  28. SET BELL OFF
  29. DEFINE WINDOW ("Incrsrch"+Numlkp) FROM Toprow,TopCol TO Botrow,Botcol SHADOW FLOAT CLOSE
  30. ACTIVATE WINDOW ("Incrsrch"+Numlkp)                    &&    Display Window
  31. DEFINE WINDOW ("Cursrch"+Numlkp) IN WINDOW ("Incrsrch"+Numlkp) FROM 0,0 TO 0,Botcol-topcol-2 NONE
  32. ACTIVATE WINDOW ("Cursrch"+Numlkp) IN WINDOW ("Incrsrch"+Numlkp)    &&    Text window for search stuff
  33.  
  34. @0,0 SAY "Seek: "
  35. *    Say the current search string
  36. IF TYPE(SYS(14,VAL(SYS(21))))="C"
  37.     @0,6 SAY Defsrch
  38. ELSE
  39.     @0,6 SAY "->Power Seek Disabled"
  40. ENDIF
  41. DEFINE WINDOW ("Lookup"+Numlkp) IN WINDOW ("Incrsrch"+Numlkp) FROM 1,0 TO Botrow-toprow-2,;
  42.  Botcol-topcol-2 NONE        &&    This is where the browse lives
  43. IF !USED('Junk')
  44.     SELECT 0            &&    Next available area
  45.     USE Junk
  46.     SELECT (Ldb)        &&    Back to browse database
  47. ENDIF
  48. SEEK Cursrch        &&    Now we SEEK with Exact off and Near on
  49. Dne = .F.
  50. MKey = IIF(Key1="NONE","","KEY "+Key1)
  51. Mkey = IIF(Key2="NONE",Mkey,Mkey+", "+Key2)
  52. Osrch=Cursrch
  53. DO WHILE .T.
  54.     SHOW WINDOW ("Lookup"+Numlkp) IN WINDOW ("Incrsrch"+Numlkp) TOP    &&    Show browse window
  55. *    The browse (yipee) uses the incr1(junk) validation clause.
  56.     BROWSE FIELDS Junk->junk:p="!":v=incr1(Junk->junk):h="":1,&Fldlist. ;
  57.     FREEZE Junk->Junk WINDOW ("Lookup"+Numlkp) IN WINDOW ("Incrsrch"+Numlkp) ;
  58.     SAVE Title TtlStr &Mkey.    &&    Do the browse...uh-huh, yea;  Do it real good
  59.     Newtop=UPPER(WONTOP())    &&    What's the current window that's on top?
  60.     DO CASE
  61.         CASE !WEXIST(TtlStr)
  62.             EXIT    &&    Browse window is closed, somehow...
  63.         CASE Newtop = "CURSRCH"+Numlkp        &&    Override power search, go direct
  64. *    This area needs some sprucing up still....
  65.             ACTIVATE WINDOW ("Cursrch"+Numlkp) IN WINDOW ("Incrsrch"+Numlkp)
  66.             CLEAR
  67.             Lk_Ind = SYS(14,VAL(SYS(21)))
  68.             DO CASE
  69.                 CASE TYPE(Lk_Ind) = "C"
  70.                 Lk_sk = PADR(Cursrch,LEN(Lk_Ind)-LEN(Cursrch))
  71.                 Lk_Pct = IIF(AT("UPPER",Lk_ind)<>0,"PICTURE '@!'","")
  72.                 @0,0 SAY "Seek: " GET Lk_sk &Lk_Pct.
  73.                 READ
  74.                 CASE TYPE(Lk_Ind) = "N"
  75.                 Lk_sk = 0.0000
  76.                 @0,0 SAY "Seek: " GET Lk_sk PICTURE "99999999.9999"
  77.                 READ
  78.                 CASE TYPE(Lk_Ind) = "D"
  79.                 Lk_sk = DATE()
  80.                 @0,0 SAY "Seek: " GET Lk_sk
  81.                 READ
  82.             ENDCASE
  83.             SEEK Lk_sk
  84.             IF TYPE(Lk_ind) = "C"
  85.                 Cursrch=TRIM(Lk_sk)
  86.             ENDIF
  87.         OTHERWISE        &&    probably a letter or backspace
  88.             IF Cursrch<>Osrch .OR. Osrch<>Cursrch
  89.                 IF TYPE(SYS(14,VAL(SYS(21)))) = "C"
  90.                     ACTIVATE WINDOW ("Cursrch"+Numlkp) IN WINDOW ("Incrsrch"+Numlkp)
  91.                     CLEAR
  92.                     @0,0 SAY "Seek: " + Cursrch    &&    Say the current search string
  93.                     SEEK Cursrch    &&    You've said it, now seek it.
  94.                 ELSE
  95.                     WAIT "Not a Character Index - No Power Seek" WINDOW
  96.                     Cursrch = ''
  97.                 ENDIF
  98.             ENDIF
  99.             Osrch = Cursrch
  100.     ENDCASE
  101. ENDDO                    &&    Loop again (go do the browse, you idiot!)
  102. IF !EMPTY(Exwin)
  103.     ACTIVATE WINDOW &Exwin.        &&    Activate the original window
  104. ELSE
  105.     ACTIVATE SCREEN
  106. ENDIF
  107. POP KEY
  108. IF USED('Junk') AND Numlkp = "1"
  109.     USE IN Junk
  110. ENDIF
  111. * Clears all windows involved
  112. IF WEXIST('Incrsrch'+Numlkp)
  113.     RELEASE WINDOW ("Incrsrch"+Numlkp)
  114. ENDIF
  115. IF WEXIST('Incrsrch'+Numlkp)
  116.     RELEASE WINDOW ("Incrsrch"+Numlkp)
  117. ENDIF
  118. IF WEXIST('Selct'+Numlkp)
  119.     RELEASE WINDOW ('Selct'+Numlkp)
  120. ENDIF
  121. IF WEXIST('Refresh')
  122.     RELEASE WINDOW Refresh
  123. ENDIF
  124. SELECT (Db)
  125. RELEASE Cursrch, Newtop, Dne
  126. Numlkp = ALLTRIM(STR(VAL(NumLkp)-1))
  127. RETURN
  128.  
  129. PROCEDURE Incr1
  130. PARAMETERS Thischar
  131. *  This proc increments the seek buffer by the value of Thischar (Junk)
  132. REPLACE Junk->Junk WITH Chr(255)
  133. IF TYPE(SYS(14,VAL(SYS(21)))) = "C"
  134.     Cursrch = Cursrch + Thischar
  135.     DEFINE WINDOW Refresh FROM 0,0 TO 0,0 NONE  &&  Refresh window
  136.     ACTIVATE WINDOW Refresh
  137. ENDIF
  138. RETURN .T.
  139.  
  140. PROCEDURE Incr2
  141. *    This proc is a Backspace, or Delete character
  142. IF TYPE(SYS(14,VAL(SYS(21)))) = "C"
  143.     Cursrch = IIF(LEN(Cursrch)>0,LEFT(Cursrch,LEN(Cursrch)-1),"")
  144.     DEFINE WINDOW Refresh FROM 0,0 TO 0,0 NONE  &&  Refresh window
  145.     ACTIVATE WINDOW REFRESH
  146. ENDIF
  147. RETURN
  148.  
  149. PROCEDURE Incrclr
  150. *    Clear the Seekbuf
  151. Lk_ind = TYPE(SYS(14,VAL(SYS(21))))
  152. Cursrch = IIF(Lk_ind = "C","",IIF(Lk_ind = "D",{  /  /  },0))
  153. Osrch = IIF(Lk_ind = "C","1",IIF(Lk_ind = "D",{01/01/01},1))
  154. IF Lk_ind<> "C"
  155.     ACTIVATE WINDOW ("Cursrch"+Numlkp) IN WINDOW ("Incrsrch"+Numlkp)
  156.     CLEAR
  157.     @0,0 SAY "Seek: ->Power Seek Disabled"
  158. ENDIF
  159. DEFINE WINDOW Refresh FROM 0,0 TO 0,0 NONE  &&  Refresh window
  160. ACTIVATE WINDOW REFRESH
  161. RETURN
  162.  
  163. PROCEDURE Keyset
  164. *    Reset the On Key Labels...
  165. ON KEY LABEL Backspace DO incr2                &&    Cursrch = Cursrch -1
  166. ON KEY LABEL TAB DO Incrclr                    &&    Clear Cursrch
  167. RETURN
  168.