home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBEXS.EXE / TBEX19.PRG < prev    next >
Encoding:
Text File  |  1992-03-18  |  2.4 KB  |  97 lines
  1. // Tbex19.prg
  2. //
  3. // DbLookup function, accepting FOR and WHILE clauses
  4. //
  5. // Must link with Tbutils, Dict
  6.  
  7. #include "Inkey.ch"
  8.  
  9. // Default column separator
  10. #define DEF_CSEP  " " + chr(179) + " "
  11.  
  12. // Default heading separator
  13. #define DEF_HSEP chr(205) + chr(209) + chr(205)
  14.  
  15. // Default footing separator
  16. #define DEF_FSEP chr(205) + chr(207) + chr(205)
  17.  
  18. // Increment last character of a string. Useful for scoped tbrowses
  19. #define INCLAST(c) substr(c, 1, len(c) - 1) + ;
  20.                    chr( asc( substr( c, len(c) ) ) + 1)
  21.  
  22. FUNCTION Test
  23.  
  24. LOCAL bGoFirst
  25. LOCAL bGoLast
  26. LOCAL bWhile
  27. LOCAL bFor
  28. LOCAL cSearcher := "S"
  29.  
  30. FIELD Lname
  31.  
  32.   // If we do not find a record goto 0
  33.   bGoFirst := {|| DbSeek(cSearcher) }
  34.   bGoLast  := {|| DbSeek(INCLAST(cSearcher), .T.), ;
  35.                   DbSkip(-1) }
  36.   bWhile   := {|| Upper(Lname) = cSearcher }
  37.   bFor     := {|| .T. }
  38.  
  39.   CLEAR SCREEN
  40.   DbLookup("tbdbf1", "tbdbf1", {"Lname", "Fname", "Acbal"}, ;
  41.            bGoFirst, bGoLast, bWhile, bFor)
  42.   ? Recno()
  43.  
  44. RETURN NIL
  45.  
  46.  
  47. FUNCTION DbLookup(cDbfName, cNtxName, aFieldNames, ;
  48.                   bGoFirst, bGoLast, bWhile, bFor)
  49.  
  50. LOCAL nSaveSel := Select()
  51. LOCAL oTbr := TBrowseDB(11, 11, 19, 69)
  52. LOCAL cSaveScr := SaveScreen(10, 10, 20, 70)
  53. LOCAL nField
  54. LOCAL oTbcTemp
  55. LOCAL lExitRequested := .F.
  56. LOCAL nKey
  57.  
  58.   oTbr:headSep := DEF_HSEP
  59.   oTbr:footSep := DEF_FSEP
  60.   oTbr:colSep  := DEF_CSEP
  61.  
  62.   @ 10, 10 TO 20, 70
  63.   USE (cDbfName) NEW INDEX (cNtxName)
  64.  
  65.   // See section called general purpose while and for condition
  66.   // for details of these filtered browse routines, and tb12.prg
  67.   oTbr:goTopBlock    := {||  TBFwFirst(bGoFirst, bWhile, bFor) }
  68.   oTbr:goBottomBlock := {||  TBFwLast(bGoLast,   bWhile, bFor) }
  69.   oTbr:skipBlock     := {|n| TBFwSkip(n,         bWhile, bFor) }
  70.  
  71.   // Create and add a TBColumn object for each database field in
  72.   // the aFieldNames array
  73.   FOR nField := 1 TO Len(aFieldNames)
  74.     oTbcTemp := TBColumnNew(aFieldNames[nField], ;
  75.                             FieldBlock(aFieldNames[nField]))
  76.     oTbr:addColumn(oTbcTemp)
  77.   NEXT
  78.  
  79.   oTbr:goTop()
  80.  
  81.   DO WHILE !lExitRequested
  82.     DO WHILE !oTbr:stabilize()
  83.     ENDDO
  84.     nKey := InKey(0)
  85.     IF !StdMeth(nKey, oTbr)
  86.       DO CASE
  87.         CASE nKey == K_ESC .OR. nKey == K_ENTER
  88.           lExitRequested := .T.
  89.       ENDCASE
  90.     ENDIF
  91.   ENDDO
  92.  
  93.   SELECT (nSaveSel)
  94.   RestScreen(10, 10, 20, 70, cSaveScr)
  95.  
  96. RETURN NIL
  97.