home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / SUPRSEEK.ZIP / SUPRSEEK.PRG
Encoding:
Text File  |  1994-12-28  |  6.3 KB  |  177 lines
  1. *:*****************************************************************************
  2. *:
  3. *: Procedure file: D:\SUPRSEEK.PRG
  4. *:
  5. *:      Author: Wayne A. Willingham
  6. *:      Copyright (c) 1993, Survivor Software Solutions
  7. *:
  8. *:      PO Box 832366
  9. *:      Richardson, TX 75083
  10. *:      Voice: (214) 783-0094  Fax: (214) 783-0095
  11. *:      CompuServe 76170,2016
  12. *:
  13. *:      Last modified: 09/10/93      2:23
  14. *:
  15. *:*****************************************************************************
  16. *:      SuperSeek is freeware, as long as the author is given credit,
  17. *:      and is informed of any nice improvements you make! <g>
  18. *:*****************************************************************************
  19. *:
  20. *:  SuperSeek! is designed to do instant searches on the current index
  21. *:  when that index is UPPER(<fieldname>) on any character field
  22. *:
  23. *:  This is very similar to a Quicken search routine
  24. *:
  25. *:  PARAMETERS are as follows:
  26. *:    lnRow = Row to start SuperSeek! window on
  27. *:    lnCol = Column to start SuperSeek! window on
  28. *:    lcWind= Window to put Superseek! window in
  29. *:    
  30. *:    By telling SuperSeek the row, column and window,
  31. *:    you can place the Superseek window right on top 
  32. *:    of the field you're searching on.  Since the 
  33. *:    SuperSeek window is exactly the same size as
  34. *:    there are characters in that field, it looks
  35. *:    like a select-on-entry GET.
  36. *:    
  37. *:  This program makes extensive use on SYS(14) and SYS(21)  
  38. *:
  39. *:    The following is text I put into the help file,
  40. *:    putting "SET TOPIC TO SUPERSEEK" in the procedure.
  41. *:
  42. *:    ╓──────────────────────────╖                 
  43. *:    ║       SuperSeek!         ║                 
  44. *:    ╙──────────────────────────╜                 
  45. *:                                                 
  46. *:    With SuperSeek!, you can find any given       
  47. *:    record almost instantly.                     
  48. *:                                                 
  49. *:    SuperSeek is available from the Database     
  50. *:    pull-down menu.   Just start typing what     
  51. *:    you're looking for, and it'll appear.  If    
  52. *:    there is no matching entry, a beep will      
  53. *:    sound, and you can try again.                
  54. *:                                                 
  55. *:    Even after searching, you can press 
  56. *:    ESCAPE to quit SuperSeek, and stay on the    
  57. *:    record you started SuperSeek from.     
  58. *:                                                 
  59. *:    The DELETE key clears the SuperSeek          
  60. *:    highlight so you can start from scratch.     
  61. *:                                                 
  62. *:    The up/down arrow keys will move you through 
  63. *:    the database forward or backward in order by 
  64. *:    the field you're in.                         
  65. *:                                                 
  66. *:    The left/right arrow keys add or subtract    
  67. *:    letters from your search string.             
  68. *:                                                 
  69. *:    Press ENTER to stay on the found record.     
  70. *:                                                 
  71. *:
  72. *:*****************************************************************************
  73. PARAMETERS lnRow, lnCol, lcwind
  74.  
  75. **** Verify that index is UPPER(expC)?
  76. IF TYPE(sys(14,val(sys(21)))) <> "C"  AND !("UPPER"$sys(14,val(sys(21))))
  77.    WAIT WINDOW TIMEOUT 30 "Index must be upper(character) type!"
  78.    RETURN
  79. ENDIF
  80.  
  81. **** Define variable & store environment settings
  82. PRIVATE tofind, oldrec       
  83. tofind = ""                   && What we're SEEKing
  84. oldrec = recno()              && In case of abort, return to old record
  85. oldins = insmode()            && Save current INSMODE() status
  86. =INSMODE(.f.)                 && Let's get a BIG CURSOR using INSMODE
  87.  
  88. ****  SCREEN LAYOUT   ****
  89. ***   If no parameters, center the seek window
  90. IF PARAMETERS() < 1              
  91.    lnRow = INT(srows()/2)-1
  92. ENDIF
  93. IF PARAMETERS() < 2           
  94.    lnCol=IIF(int(scols()-len(evaluate(sys(14,val(sys(21)))))-14)/2<15,15, ;
  95.       int(scols()-len(evaluate(sys(14,val(sys(21)))))-14)/2)
  96. ENDIF
  97.  
  98. *** If no window is specified, place window in screen
  99. c_where=IIF(PARAMETERS() > 2,lcwind,"screen")
  100.  
  101. DEFINE WINDOW fastseek IN (c_where) FROM lnRow,lnCol ;
  102.    TO lnRow,lnCol-1+LEN(EVALUATE(SYS(14,VAL(SYS(21))))) ;
  103.    NONE NOCLOSE NOZOOM NOFLOAT ;
  104.    COLOR SCHEME 6
  105. ACTIVATE WINDOW fastseek NOSHOW
  106. DO upd_disp
  107.  
  108. *** Tell the user what's happening, and start
  109. WAIT WINDOW NOWAIT "SuperSeek on "+order()
  110. ACTIVATE WINDOW fastseek
  111.  
  112. active = .t.                   && exit variable
  113. DO WHILE active
  114.    DO keyin
  115. ENDDO
  116.  
  117. *** cleanup
  118. SHOW GETS
  119. DEACTIVATE WINDOW fastseek
  120. RELEASE WINDOW fastseek
  121. =INSMODE(oldins)
  122. SHOW GETS
  123.  
  124. *** the actual display
  125. PROC upd_disp
  126. * clear line
  127. @ 0,0 SAY SPACE(LEN(EVALUATE(sys(14,val(sys(21))))))    COLOR SCHEME 6
  128. * put in what has been found
  129. @ 0,0 SAY ALLTRIM(IIF(EMPTY(tofind),SPACE(LEN(EVALUATE(SYS(14,val(SYS(21)))))), ;
  130.    EVALUATE(SYS(14,VAL(SYS(21)))))) COLOR SCHEME 6
  131. * overlay with the SEEK expression
  132. @ 0,0 SAY tofind COLOR SCHEME 5
  133. SHOW GETS
  134.  
  135.  
  136. ***    take keystroke, evaluate action, or add to SEEK string
  137. PROC keyin
  138. DO upd_disp
  139. key = INKEY(15,"S")
  140. DO CASE
  141. CASE key=0 OR key=9 OR key=27 OR (key=13 AND EMPTY(tofind)) && ESCAPE
  142.    GO oldrec
  143.    active = .F.
  144.    RETURN
  145. CASE key = 13                                          && RETURN
  146.    active = .F.
  147.    RETURN
  148. CASE key = 127 OR key = 19                             && BACKSPACE/LEFTARROW
  149.    tofind = LEFT(tofind,LEN(tofind)-1)
  150. CASE key = 7 OR key = 1                                && DELETE/HOME
  151.    tofind = ""
  152. CASE key = 4                                           && RIGHTARROW
  153.    tofind = LEFT(EVALUATE(SYS(14,VAL(SYS(21)))),LEN(tofind)+1)
  154. CASE key = 5                                           && UPARROW
  155.    SKIP -1
  156.    IF BOF()
  157.       GO TOP
  158.    ENDIF
  159.    tofind = ALLTRIM(EVALUATE(SYS(14,VAL(SYS(21)))))
  160. CASE key = 24                                          && DOWNARROW
  161.    SKIP 1
  162.    IF EOF()
  163.       GO BOTTOM
  164.    ENDIF
  165.    tofind = ALLTRIM(EVALUATE(SYS(14,VAL(SYS(21)))))
  166. OTHERWISE                                              && ALL ELSE
  167.    newkey = UPPER(CHR(key))
  168.    tofind = tofind+newkey
  169.    *** if string not found, shorten it by one character
  170.    DO WHILE !SEEK(tofind) AND LEN(tofind)>0 AND active
  171.       ?? CHR(7)
  172.       tofind = LEFT(tofind,LEN(tofind)-1)
  173.    ENDDO
  174. ENDCASE
  175. *: EOF: SUPRSEEK.PRG
  176.  
  177.