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