home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB17.PRG < prev    next >
Encoding:
Text File  |  1992-03-04  |  6.4 KB  |  232 lines
  1.     // Tb17.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. Handles empty databases as well.
  4.     // AUTOMATIC append mode
  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.     MEMVAR getList
  14.  
  15.     FUNCTION Tb17
  16.  
  17.     FIELD Lname, Fname, Addr1, Addr2, Addr3 IN Tbdbf1
  18.  
  19.     LOCAL oTbr
  20.     LOCAL lExitRequested := .F.
  21.     LOCAL nKey
  22.     LOCAL nSr, nSc
  23.     LOCAL bNext
  24.     LOCAL bPrev
  25.  
  26.       Set(_SET_SCOREBOARD, .F.)
  27.       Set(_SET_CURSOR,     SC_NONE)
  28.  
  29.       USE Tbdbf1
  30.       IF !File("Tbdbf1.ntx")
  31.         INDEX ON Upper(Lname + Fname) TO Tbdbf1
  32.       ELSE
  33.         SET INDEX TO Tbdbf1
  34.       ENDIF
  35.     
  36.       CLEAR SCREEN
  37.       @ 0, 0 TO 23, 79
  38.  
  39.       oTbr := TBrowseDb(1, 1, 22, 78)
  40.       AddAllFields(oTbr)
  41.  
  42.       oTbr:cargo := DictNew()
  43.  
  44.       // For automatic append mode ...
  45.       APPEND_MODE(oTbr, .T.)
  46.  
  47.       bNext := {|| TBaGoNext(APPEND_MODE(oTbr)) }
  48.       bPrev := {|| TBaGoPrev() }
  49.  
  50.       oTbr:skipBlock     := {|n| DbSkipBlock(n, bNext, bPrev) }
  51.       oTbr:goTopBlock    := {||  TBaGoFirst() }
  52.       oTbr:goBottomBlock := {||  TBaGoLast(APPEND_MODE(oTbr)) }
  53.  
  54.       DO WHILE !lExitRequested
  55.         FullStabilize(oTbr)
  56.  
  57.         IF !lExitRequested
  58.           nKey := InKey(0)
  59.           IF nKey == K_ESC
  60.             lExitRequested := .T.
  61.           ELSE
  62.             KeyHandle(nKey, oTbr)
  63.           ENDIF
  64.         ENDIF
  65.       ENDDO
  66.  
  67.       CLEAR SCREEN
  68.  
  69.     RETURN NIL
  70.  
  71.  
  72.     FUNCTION KeyHandle(nKey, oTbr)
  73.  
  74.       IF !StdMeth(nKey, oTbr)
  75.         DO CASE
  76.           CASE nKey == K_ENTER   // EDIT key
  77.             IF oTbr:stable
  78.               FldEdit(oTbr)
  79.             ENDIF
  80.  
  81.           CASE nKey == K_INS
  82.             oTbr:goBottom()
  83.   
  84.           CASE nKey >= 32 .AND. nKey <= 255
  85.             IF oTbr:stable
  86.               KEYBOARD chr(K_ENTER) + chr(nKey)
  87.             ENDIF
  88.         ENDCASE
  89.       ENDIF
  90.  
  91.     RETURN NIL
  92.  
  93.  
  94.     FUNCTION FldEdit(oTbr)
  95.  
  96.     LOCAL bFldGsb, cFval, lSaveCurs
  97.     LOCAL cNewKeyVal, cOldKeyVal
  98.     LOCAL aCols  := TbcColPos(oTbr)
  99.     LOCAL aFvals := Array(oTbr:rightVisible)
  100.     LOCAL i, lMemoUpdated := .F.
  101.     LOCAL cMemoDisplay := "Memo"
  102.     LOCAL aMemoVals := {}
  103.     LOCAL nMemoNum
  104.  
  105.       nMemoNum := 0   // How many memos we've had so far
  106.       FOR i := oTbr:leftVisible TO oTbr:rightVisible
  107.         // tbColumn's block instance var is a get / set block
  108.         bFldGsb := oTbr:getColumn(i):block
  109.   
  110.         // Get its contents to check whether really a memo ...
  111.         aFvals[i] := Eval(bFldGsb)
  112.         IF valtype(aFvals[i]) == "C" .AND. aFvals[i] == "Memo"
  113.           // Evaluating bFldGsb with ANY parameter returns a get / set
  114.           // block for memos
  115.           bFldGsb := Eval(bFldGsb, .T.)
  116.  
  117.           // Evaluate this once to get the memo's contents and store in
  118.           // aMemoVals array
  119.           Aadd(aMemoVals, eval(bFldGsb))
  120.  
  121.           // Increment memo count
  122.           nMemoNum++
  123.  
  124.           // Issue a GET on the string "Memo". Pass it the array containing
  125.           // the memos and set the get object's cargo instance variable
  126.           // to the index. The function can then access this subscript with
  127.           // GetActive():cargo.
  128.           @ Row(), aCols[i] GET cMemoDisplay ;
  129.             WHEN MemoFunc(@lMemoUpdated, aMemoVals)
  130.  
  131.           GetList[len(GetList)]:cargo := nMemoNum
  132.  
  133.         ELSE
  134.           @ Row(), aCols[i] GET aFvals[i]
  135.         ENDIF
  136.  
  137.       NEXT
  138.  
  139.       // We must save old index key val to see whether
  140.       // it changed after the edit
  141.       cOldKeyVal := &(IndexKey())
  142.   
  143.       lSaveCurs := Set(_SET_CURSOR, SC_NORMAL)
  144.       READ
  145.       Set(_SET_CURSOR, lSaveCurs)
  146.  
  147.       IF (Updated() .OR. lMemoUpdated) .AND. LastKey() != K_ESC
  148.         IF Eof()
  149.           APPEND BLANK
  150.           DO WHILE NetErr()
  151.             APPEND BLANK
  152.           ENDDO
  153.         ELSE
  154.           DO WHILE !Rlock()
  155.           ENDDO
  156.         ENDIF
  157.  
  158.         // Update all fields
  159.         nMemoNum := 0
  160.         FOR i := oTbr:leftVisible TO oTbr:rightVisible
  161.           // tbColumn's block instance var is a get / set block
  162.           bFldGsb := oTbr:getColumn(i):block
  163.           cFval := Eval(bFldGsb)
  164.  
  165.           // Special handling for memos
  166.           IF valtype(cFval) == "C" .AND. cFval == "Memo"
  167.             nMemoNum++
  168.  
  169.             // Evaluating this with ANY parameter returns a get / set
  170.             // block for the memo field
  171.             bFldGsb := Eval(bFldGsb, .T.)
  172.  
  173.             // Now update the memo field to what we saved in the array
  174.             Eval(bFldGsb, aMemoVals[nMemoNum])
  175.           ELSE
  176.             // Update the field
  177.             Eval(bFldGsb, aFvals[i])
  178.           ENDIF
  179.         NEXT
  180.  
  181.         UNLOCK
  182.  
  183.         // Get new key value - If you already have a code block
  184.         // on the current index key, simply eval it here instead
  185.         cNewKeyVal := &(IndexKey())
  186.         // If the key changed, refreshAll()
  187.         IF cOldKeyVal != cNewKeyVal
  188.           DbStabilize(oTbr)
  189.         ELSE
  190.           oTbr:refreshcurrent()
  191.         ENDIF
  192.       ELSE   // !updated()
  193.         // To remove reverse video from gets
  194.         oTbr:refreshCurrent()
  195.       ENDIF
  196.  
  197.     RETURN .F.
  198.  
  199.  
  200.     #define MEMO_TOP    10
  201.     #define MEMO_LEFT   20
  202.     #define MEMO_BOTTOM 20
  203.     #define MEMO_RIGHT  60
  204.  
  205.     // Edit memo field. lMemoUpdated is passed by reference. Set it .T.
  206.     // if this memo was updated, otherwise do not change it. aMemoVals
  207.     // contains a reference to the array containing the memo fields' values
  208.     FUNCTION MemoFunc(lMemoUpdated, aMemoVals)
  209.  
  210.     LOCAL cSaveScr, cFval
  211.     LOCAL lThisMemoUpdated
  212.  
  213.       cSaveScr := SaveScreen(MEMO_TOP, MEMO_LEFT, ;
  214.                              MEMO_BOTTOM, MEMO_RIGHT)
  215.       @ MEMO_TOP, MEMO_LEFT TO ;
  216.         MEMO_BOTTOM, MEMO_RIGHT
  217.       cFval := MemoEdit(aMemoVals[GetActive():cargo],  ;
  218.                         MEMO_TOP + 1, MEMO_LEFT + 1,   ;
  219.                         MEMO_BOTTOM - 1, MEMO_RIGHT - 1)
  220.       lThisMemoUpdated := LastKey() == K_CTRL_W
  221.       RestScreen(MEMO_TOP, MEMO_LEFT, MEMO_BOTTOM, ;
  222.                  MEMO_RIGHT, cSaveScr)
  223.  
  224.       IF lThisMemoUpdated
  225.         // This updates the array element, but not the field. This is
  226.         // done later.
  227.         aMemoVals[GetActive():cargo] := cFval
  228.         lMemoUpdated := .T.
  229.       ENDIF
  230.  
  231.     RETURN .F.
  232.