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