home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB19.PRG < prev    next >
Encoding:
Text File  |  1992-03-04  |  8.4 KB  |  291 lines
  1.     // Tb19.prg
  2.     //
  3.     // Uses TBfwaBrowse to create the tbrowse object with goTopBlock,
  4.     // goBottomBlock, and skipBlock set to browse databases with while and
  5.     // for conditions and append mode
  6.  
  7.     // Compile with /a /m /n /w
  8.     // Link with Tbutils, Dict
  9.  
  10.     #include "Inkey.ch"
  11.     #include "Setcurs.ch"
  12.     #include "Tbutils.ch"
  13.  
  14.     #define MOVE_UP_KEY(nKey) chr(nKey) $ (chr(K_UP) + chr(K_PGUP) + chr(K_CTRL_PGUP))
  15.  
  16.  
  17.     MEMVAR getList
  18.  
  19.     FUNCTION Tb19
  20.  
  21.     FIELD Lname, Fname, Addr1, Addr2, Addr3, AcBal IN Tbdbf1
  22.  
  23.     LOCAL oTbr
  24.     LOCAL lExitRequested := .F.
  25.     LOCAL nKey
  26.     LOCAL nSr, nSc
  27.     LOCAL bWhile := {|| Upper(Lname) = "SPENCE" }
  28.     LOCAL bFor   := {|| AcBal > 0 }
  29.     LOCAL bFirst := {|| DbSeek("SPENCE") }
  30.     LOCAL bLast  := {|| DbSeek("SPENCF", .T.), DbSkip(-1) }
  31.  
  32.       Set(_SET_SCOREBOARD, .F.)
  33.       Set(_SET_CURSOR,     SC_NONE)
  34.  
  35.       USE TbDbf1
  36.       IF !file("TbDbf1.ntx")
  37.         INDEX ON Upper(Lname + Fname) TO TbDbf1
  38.       ELSE
  39.         SET INDEX TO TbDbf1
  40.       ENDIF
  41.     
  42.       CLEAR SCREEN
  43.       @ 0, 0 TO 23, 79
  44.  
  45.       oTbr := TBfwaBrowse(bWhile, bFor, bFirst, bLast)
  46.  
  47.       oTbr:nTop    := 1
  48.       oTbr:nLeft   := 1
  49.       oTbr:nBottom := 22
  50.       oTbr:nRight  := 78
  51.  
  52.       oTbr:addColumn(TBColumnNew("Rec #",      {|| Recno() } ))
  53.  
  54.       oTbr:freeze := 1
  55.  
  56.       oTbr:addColumn(TBColumnNew("Last Name",  FieldBlock("Lname")))
  57.       oTbr:addColumn(TBColumnNew("First Name", FieldBlock("Fname")))
  58.       oTbr:addColumn(TBColumnNew("Acbal",      FieldBlock("AcBal")))
  59.  
  60.       // To make automatic APPEND mode 
  61. //      APPEND_MODE(oTbr, .T.)
  62.  
  63.       DO WHILE !lExitRequested
  64.         FullStabilize(oTbr)
  65.   
  66.         IF oTbr:hitBottom .AND. !APPEND_MODE(oTbr) .AND. ;
  67.                 Alert("Add record", {"Yes", "No"}) = 1
  68.  
  69.           APPEND_MODE(oTbr, .T.)
  70.           oTbr:goBottom()
  71.           FullStabilize(oTbr)
  72.         ELSEIF (Eof() .OR. LastRec() = 0) .AND. !APPEND_MODE(oTbr)
  73.           // No records in database or none matching scope
  74.           IF Alert("Add record", {"Yes", "No"}) = 1
  75.             APPEND_MODE(oTbr, .T.)
  76.             oTbr:down()
  77.             FullStabilize(oTbr)
  78.           ELSE
  79.              lExitRequested := .T.
  80.           ENDIF
  81.         ENDIF
  82.  
  83.         nSr := Row()
  84.         nSc := Col()
  85.         @ 24, 0  SAY iif(APPEND_MODE(oTbr), "Appending", "         ")
  86.         @ nSr, nSc SAY ""
  87.   
  88.         IF !lExitRequested
  89.           nKey := InKey(0)
  90.           IF nKey == K_ESC
  91.             // Special case Escape if we are appending
  92.             IF APPEND_MODE(oTbr)
  93.               APPEND_MODE(oTbr, .F.)
  94.               oTbr:refreshAll()
  95.             ELSE
  96.               lExitRequested := .T.
  97.             ENDIF
  98.           ELSE
  99.             KeyHandle(nKey, oTbr, bWhile, bFor, )
  100.           ENDIF
  101.         ENDIF
  102.       ENDDO
  103.  
  104.       CLEAR SCREEN
  105.  
  106.     RETURN NIL
  107.   
  108.  
  109.     FUNCTION FldEdit(oTbr, bWhile, bFor)
  110.  
  111.     LOCAL bFldGsb, cFval, lSaveCurs
  112.     LOCAL cNewKeyVal, cOldKeyVal
  113.     LOCAL aCols := TbcColPos(oTbr)
  114.     LOCAL aFvals := Array(oTbr:rightVisible)
  115.     LOCAL i, lMemoUpdated := .F.
  116.     LOCAL cMemoDisplay := "Memo"
  117.     LOCAL aMemoVals := {}
  118.     LOCAL nMemoNum
  119.  
  120.       nMemoNum := 0   // How many memos we've had so far
  121.       FOR i := oTbr:leftVisible TO oTbr:rightVisible
  122.         // tbColumn's block instance var is a get / set block
  123.         bFldGsb := oTbr:getColumn(i):block
  124.   
  125.         // Get its contents to check whether really a memo ...
  126.         aFvals[i] := Eval(bFldGsb)
  127.         IF valtype(aFvals[i]) == "C" .AND. aFvals[i] == "Memo"
  128.           // Evaluating bFldGsb with ANY parameter returns a get / set
  129.           // block for memos
  130.           bFldGsb := Eval(bFldGsb, .T.)
  131.  
  132.           // Evaluate this once to get the memo's contents and store in
  133.           // aMemoVals array
  134.           aadd(aMemoVals, Eval(bFldGsb))
  135.  
  136.           // Increment memo count
  137.           nMemoNum++
  138.  
  139.           // Issue a GET on the string "Memo". Pass it the array containing
  140.           // the memos and set the get object's cargo instance variable
  141.           // to the index. The function can then access this subscript with
  142.           // GetActive():cargo.
  143.           @ Row(), aCols[i] GET cMemoDisplay ;
  144.             WHEN MemoFunc(@lMemoUpdated, aMemoVals)
  145.  
  146.           GetList[len(GetList)]:cargo := nMemoNum
  147.  
  148.         ELSE
  149.           @ Row(), aCols[i] GET aFvals[i]
  150.         ENDIF
  151.  
  152.       NEXT
  153.  
  154.       // We must save old index key val to see whether
  155.       // it changed after the edit
  156.       cOldKeyVal := &(IndexKey())
  157.   
  158.       lSaveCurs := Set(_SET_CURSOR, SC_NORMAL)
  159.       READ
  160.       Set(_SET_CURSOR, lSaveCurs)
  161.  
  162.       IF (Updated() .OR. lMemoUpdated) .AND. LastKey() != K_ESC
  163.         IF Eof()
  164.           APPEND BLANK
  165.           DO WHILE NetErr()
  166.             APPEND BLANK
  167.           ENDDO
  168.         ELSE
  169.           DO WHILE !Rlock()
  170.           ENDDO
  171.         ENDIF
  172.  
  173.         // Update all fields
  174.         nMemoNum := 0
  175.         FOR i := oTbr:leftVisible TO oTbr:rightVisible
  176.           // tbColumn's block instance var is a get / set block
  177.           bFldGsb := oTbr:getColumn(i):block
  178.           cFval := Eval(bFldGsb)
  179.  
  180.           // Special handling for memos
  181.           IF ValType(cFval) == "C" .AND. cFval == "Memo"
  182.             nMemoNum++
  183.  
  184.             // Evaluating this with ANY parameter returns a get / set
  185.             // block for the memo field
  186.             bFldGsb := Eval(bFldGsb, .T.)
  187.  
  188.             // Now update the memo field to what we saved in the array
  189.             Eval(bFldGsb, aMemoVals[nMemoNum])
  190.           ELSE
  191.             // Update the field
  192.             Eval(bFldGsb, aFvals[i])
  193.           ENDIF
  194.         NEXT
  195.  
  196.         UNLOCK
  197.  
  198.         // First check to see whether current record still
  199.         // satisfies the filter condition
  200.         IF !Eval(bWhile) .OR. !Eval(bFor)
  201.           // The current record is no longer in scope.
  202.           // Move back to the first record in the scope
  203.           APPEND_MODE(oTbr, .F.)
  204.           oTbr:refreshAll()
  205.           oTbr:goTop()
  206.         ELSE
  207.           // Get new key value - If you already have a code block
  208.           // on the current index key, simply eval it here instead
  209.           cNewKeyVal := &(IndexKey())
  210.           // If the key changed, refreshAll()
  211.           IF cOldKeyVal != cNewKeyVal .OR. APPEND_MODE(oTbr)
  212.             IF APPEND_MODE(oTbr)
  213.               APPEND_MODE(oTbr, .F.)
  214.             ENDIF
  215.             DbStabilize(oTbr)
  216.           ELSE
  217.             oTbr:refreshCurrent()
  218.           ENDIF
  219.         ENDIF
  220.       ELSE   // !updated()
  221.         // To remove reverse video from gets
  222.         oTbr:refreshCurrent()
  223.       ENDIF
  224.  
  225.     RETURN .F.
  226.  
  227.  
  228.     #define MEMO_TOP    10
  229.     #define MEMO_LEFT   20
  230.     #define MEMO_BOTTOM 20
  231.     #define MEMO_RIGHT  60
  232.  
  233.     // Edit memo field. lMemoUpdated is passed by reference. Set it .T.
  234.     // if this memo was updated, otherwise do not change it. aMemoVals
  235.     // contains a reference to the array containing the memo fields' values
  236.  
  237.     FUNCTION MemoFunc(lMemoUpdated, aMemoVals)
  238.  
  239.     LOCAL cSaveScr, cFval
  240.     LOCAL lThisMemoUpdated
  241.  
  242.       cSaveScr := SaveScreen(MEMO_TOP, MEMO_LEFT, ;
  243.                              MEMO_BOTTOM, MEMO_RIGHT)
  244.       @ MEMO_TOP, MEMO_LEFT TO ;
  245.         MEMO_BOTTOM, MEMO_RIGHT
  246.       cFval := MemoEdit(aMemoVals[GetActive():cargo],  ;
  247.                         MEMO_TOP + 1, MEMO_LEFT + 1,   ;
  248.                         MEMO_BOTTOM - 1, MEMO_RIGHT - 1)
  249.       lThisMemoUpdated := lastkey() == K_CTRL_W
  250.       RestScreen(MEMO_TOP, MEMO_LEFT, MEMO_BOTTOM, ;
  251.                  MEMO_RIGHT, cSaveScr)
  252.  
  253.       IF lThisMemoUpdated
  254.         // This updates the array element, but not the field. This is
  255.         // done later.
  256.         aMemoVals[GetActive():cargo] := cFval
  257.         lMemoUpdated := .T.
  258.       ENDIF
  259.  
  260.     RETURN .F.
  261.  
  262.  
  263.     FUNCTION KeyHandle(nKey, oTbr, bWhile, bFor)
  264.  
  265.       IF StdMeth(nKey, oTbr)
  266.         // Processed key as standard key
  267.         IF MOVE_UP_KEY(nKey) .AND. APPEND_MODE(oTbr) .AND. LastRec() != 0
  268.           APPEND_MODE(oTbr, .F.)
  269.           oTbr:refreshAll()
  270.         ENDIF
  271.       ELSE
  272.         DO CASE
  273.           CASE nKey == K_ENTER   // EDIT key
  274.             IF oTbr:stable
  275.                FldEdit(oTbr, bWhile, bFor)
  276.             ENDIF
  277.  
  278.           CASE nKey == K_INS
  279.             APPEND_MODE(oTbr, .T.)
  280.             oTbr:goBottom()
  281.   
  282.           CASE nKey >= 32 .AND. nKey <= 255
  283.             IF oTbr:stable
  284.               KEYBOARD chr(K_ENTER) + chr(nKey)
  285.             ENDIF
  286.   
  287.         ENDCASE
  288.       ENDIF
  289.  
  290.     RETURN NIL
  291.