home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB15.PRG < prev    next >
Encoding:
Text File  |  1992-03-04  |  6.3 KB  |  209 lines
  1.     // Tb15.prg - Demonstrate editing records during tbrowse display.
  2.     //            While and for conditions are set, and we ensure
  3.     //            the same record is highlighted after the display
  4.     //            No append mode. Rewrite of tb14 to allow editing
  5.     //            of all columns.
  6.  
  7.     // Compile with /a /m /n /w
  8.     // Link with tbutils, tb07
  9.  
  10.     #include "Inkey.ch"
  11.     #include "Setcurs.ch"
  12.  
  13.     MEMVAR getList
  14.  
  15.     FUNCTION Tb15
  16.  
  17.     FIELD Lname, Fname, AcBal IN TbDbf1
  18.  
  19.     LOCAL oTbr
  20.     LOCAL lExitRequested := .F.
  21.     LOCAL nKey
  22.     LOCAL nSr, nSc
  23.     LOCAL bNext
  24.     LOCAL bPrev
  25.     LOCAL bWhile, bFor
  26.     LOCAL bFirst, bLast
  27.     LOCAL aAfterKeys := { ;
  28.                           { K_ENTER, {|oTbr| FldEdit(oTbr, bWhile, bFor) }} ;
  29.                         }
  30.  
  31.       bFirst := {|| DbSeek("SPENCE") }
  32.       bLast  := {|| DbSeek("SPENCF", .T.), DbSkip(-1) }
  33.       bFor   := {|| AcBal > 0 }
  34.       bWhile := {|| Upper(Lname) = "SPENCE" }
  35.  
  36.       Set(_SET_SCOREBOARD, .F.)
  37.       Set(_SET_CURSOR,     SC_NONE)
  38.  
  39.       USE Tbdbf1
  40.       IF !File("Tbdbf1.ntx")
  41.         INDEX ON Upper(Lname + Fname) TO Tbdbf1
  42.       ELSE
  43.         SET INDEX TO Tbdbf1
  44.       ENDIF
  45.     
  46.       CLEAR SCREEN
  47.       @ 0, 0 TO 23, 79
  48.  
  49.       oTbr := TBrowseNew(1, 1, MaxRow() - 1, MaxCol() - 1)
  50.       AddAllFields(oTbr)
  51.  
  52.       oTbr:insColumn(1, TBColumnNew("Rec #", {|| Recno() }))
  53.       oTbr:freeze := 1
  54.  
  55.       oTbr:goTopBlock    := {|| TBFwFirst(bFirst, bWhile, bFor) }
  56.       oTbr:goBottomBlock := {|| TBFwLast(bLast, bWhile, bFor)   }
  57.  
  58.       bNext := {|| TBFwGoNext(bFor, bWhile) }
  59.       bPrev := {|| TBFwGoPrev(bFor, bWhile) }
  60.  
  61.       oTbr:skipBlock := {|n| DbSkipBlock(n, bNext, bPrev) }
  62.       CLEAR SCREEN
  63.       @ 0, 0 TO MaxRow(), MaxCol()
  64.       oTbr:goTop()
  65.       IF !Eval(bWhile)
  66.         Alert("No matching records", {"OK"})
  67.       ELSE
  68.         MyBrowse2(oTbr,, aAfterKeys)
  69.       ENDIF
  70.  
  71.     RETURN NIL
  72.  
  73.  
  74.     FUNCTION FldEdit(oTbr, bWhile, bFor)
  75.  
  76.     LOCAL bFldGsb, cFval, cOldkey, lSaveCurs, cNewKey
  77.     LOCAL cNewKeyVal, cOldKeyVal
  78.     LOCAL aCols  := TbcColPos(oTbr)
  79.     LOCAL aFvals := Array(oTbr:rightVisible)
  80.     LOCAL i, lMemoUpdated := .F.
  81.     LOCAL cMemoDisplay := "Memo"
  82.     LOCAL aMemoVals := {}
  83.     LOCAL nMemoNum
  84.  
  85.       nMemoNum := 0   // How many memos we've had so far
  86.       FOR i := oTbr:leftVisible TO oTbr:rightVisible
  87.         // tbColumn's block instance var is a get / set block
  88.         bFldGsb := oTbr:getColumn(i):block
  89.   
  90.         // Get its contents to check whether really a memo ...
  91.         aFvals[i] := Eval(bFldGsb)
  92.         IF valtype(aFvals[i]) == "C" .AND. aFvals[i] == "Memo"
  93.           // Evaluating bFldGsb with ANY parameter returns a get / set
  94.           // block for memos
  95.           bFldGsb := Eval(bFldGsb, .T.)
  96.  
  97.           // Evaluate this once to get the memo's contents and store in
  98.           // aMemoVals array
  99.           Aadd(aMemoVals, Eval(bFldGsb))
  100.  
  101.           // Increment memo count
  102.           nMemoNum++
  103.  
  104.           // Issue a GET on the string "Memo". Pass it the array containing
  105.           // the memos and set the get object's cargo instance variable
  106.           // to the index. The function can then access this subscript with
  107.           // GetActive():cargo.
  108.           @ row(), aCols[i] GET cMemoDisplay ;
  109.             WHEN MemoFunc(@lMemoUpdated, aMemoVals)
  110.  
  111.           GetList[len(GetList)]:cargo := nMemoNum
  112.  
  113.         ELSE
  114.           @ Row(), aCols[i] GET aFvals[i]
  115.         ENDIF
  116.  
  117.       NEXT
  118.  
  119.       // We must save old index key val to see whether
  120.       // it changed after the edit
  121.       cOldKeyVal := &(IndexKey())
  122.   
  123.       lSaveCurs := Set(_SET_CURSOR, SC_NORMAL)
  124.       READ
  125.       Set(_SET_CURSOR, lSaveCurs)
  126.  
  127.       IF Updated() .OR. lMemoUpdated
  128.         DO WHILE !Rlock()
  129.         ENDDO
  130.  
  131.         // Update all fields
  132.         nMemoNum := 0
  133.         FOR i := oTbr:leftVisible TO oTbr:rightVisible
  134.           // tbColumn's block instance var is a get / set block
  135.           bFldGsb := oTbr:getColumn(i):block
  136.           cFval := Eval(bFldGsb)
  137.  
  138.           // Special handling for memos
  139.           IF ValType(cFval) == "C" .AND. cFval == "Memo"
  140.             nMemoNum++
  141.  
  142.             // Evaluating this with ANY parameter returns a get / set
  143.             // block for the memo field
  144.             bFldGsb := Eval(bFldGsb, .T.)
  145.  
  146.             // Now update the memo field to what we saved in the array
  147.             Eval(bFldGsb, aMemoVals[nMemoNum])
  148.           ELSE
  149.             // Update the field
  150.             Eval(bFldGsb, aFvals[i])
  151.           ENDIF
  152.         NEXT
  153.  
  154.         UNLOCK
  155.  
  156.         IF !Eval(bWhile) .OR. !Eval(bFor)
  157.           oTbr:goTop()
  158.         ELSE
  159.           // Get new key value - If you already have a code block
  160.           // on the current index key, simply eval it here instead
  161.           cNewKeyVal := &(IndexKey())
  162.           // If the key changed, refreshAll()
  163.           IF cOldKeyVal != cNewKeyVal
  164.             DbStabilize(oTbr)
  165.           ELSE
  166.             oTbr:refreshcurrent()
  167.           ENDIF
  168.         ENDIF
  169.       ELSE   // !updated()
  170.         // To remove reverse video from gets
  171.         oTbr:refreshCurrent()
  172.       ENDIF
  173.  
  174.     RETURN .F.
  175.  
  176.  
  177.     #define MEMO_TOP    10
  178.     #define MEMO_LEFT   20
  179.     #define MEMO_BOTTOM 20
  180.     #define MEMO_RIGHT  60
  181.  
  182.     // Edit memo field. lMemoUpdated is passed by reference. Set it .T.
  183.     // if this memo was updated, otherwise do not change it. aMemoVals
  184.     // contains a reference to the array containing the memo fields' values
  185.     FUNCTION MemoFunc(lMemoUpdated, aMemoVals)
  186.  
  187.     LOCAL cSaveScr, cFval
  188.     LOCAL lThisMemoUpdated
  189.  
  190.       cSaveScr := SaveScreen(MEMO_TOP, MEMO_LEFT, ;
  191.                              MEMO_BOTTOM, MEMO_RIGHT)
  192.       @ MEMO_TOP, MEMO_LEFT TO ;
  193.         MEMO_BOTTOM, MEMO_RIGHT
  194.       cFval := MemoEdit(aMemoVals[GetActive():cargo],  ;
  195.                         MEMO_TOP + 1, MEMO_LEFT + 1,   ;
  196.                         MEMO_BOTTOM - 1, MEMO_RIGHT - 1)
  197.       lThisMemoUpdated := LastKey() == K_CTRL_W
  198.       restscreen(MEMO_TOP, MEMO_LEFT, MEMO_BOTTOM, ;
  199.                  MEMO_RIGHT, cSaveScr)
  200.  
  201.       IF lThisMemoUpdated
  202.         // This updates the array element, but not the field. This is
  203.         // done later.
  204.         aMemoVals[GetActive():cargo] := cFval
  205.         lMemoUpdated := .T.
  206.       ENDIF
  207.  
  208.     RETURN .F.
  209.