home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBPRGS.EXE / TB20.PRG < prev    next >
Encoding:
Text File  |  1992-03-05  |  6.9 KB  |  240 lines
  1.     // Tb20.prg
  2.     //
  3.     // 1 - M data entry. Uses TBfwaBrowse to create second tbrowse object,
  4.     // uses automatic and persistent append mode. Good example of
  5.     // append mode with empty scopes.
  6.     
  7.     // Compile with /a /m /n /w
  8.     // Link with Tbutils, Dict
  9.     
  10.     #include "Inkey.ch"
  11.     #include "Tbutils.ch"
  12.     #include "Setcurs.ch"
  13.     
  14.     MEMVAR GetList
  15.     
  16.     #define MOVE_UP_KEY(nKey) chr(nKey) $ (chr(K_UP) + chr(K_PGUP) + chr(K_CTRL_PGUP))
  17.     
  18.     FUNCTION Sems
  19.     
  20.     LOCAL oTbrSched
  21.     LOCAL oTbc
  22.     LOCAL nKey
  23.     LOCAL lExitRequested
  24.     
  25.     FIELD City IN Sched
  26.     FIELD ClassName IN Classes
  27.     FIELD Fname IN Students
  28.     FIELD ClassId, SemId, Lname
  29.     
  30.       USE classes NEW
  31.       IF !File("Classes.ntx")
  32.         INDEX ON Classid To Classes
  33.       ELSE
  34.         SET INDEX TO classes
  35.       ENDIF
  36.     
  37.       USE Sched NEW
  38.       IF !File("Sched.ntx")
  39.         INDEX ON Semid TO Sched
  40.       ELSE
  41.         SET INDEX TO Sched
  42.       ENDIF
  43.     
  44.       USE Students NEW
  45.       IF !File("Students.ntx")
  46.         INDEX ON Upper(SemId + Lname + Fname) TO Students
  47.       ELSE
  48.         SET INDEX TO Students
  49.       ENDIF
  50.     
  51.       SELECT Sched
  52.       CLEAR SCREEN
  53.       SET SCOREBOARD OFF
  54.       BoxMsg(0, 0, 10, MaxCol(), "Schedule")
  55.       oTbrSched := TBrowseDB(1, 1, 9, MaxCol() - 1)
  56.     
  57.     //  oTbc := TBColumnNew("Class ID",   {|| ClassId })
  58.     //  oTbrSched:addColumn(oTbc)
  59.  
  60.       // Show class name rather than just id
  61.       oTbc := TBColumnNew("Class Name", ;
  62.                           {|| Classes -> (DbSeek(Sched -> ClassId)), ;
  63.                               Classes -> ClassName })
  64.       oTbrSched:addColumn(oTbc)
  65.     
  66.       oTbc := TBColumnNew("City",       {|| City })
  67.       oTbrSched:addColumn(oTbc)
  68.     
  69.       oTbc := TBColumnNew("Seminar ID", {|| SemId })
  70.       oTbrSched:addColumn(oTbc)
  71.     
  72.       oTbrSched:colSep  := DEF_CSEP
  73.       oTbrSched:headSep := DEF_HSEP
  74.     
  75.       lExitRequested := .F.
  76.       DO WHILE !lExitRequested
  77.         FullStabilize(oTbrSched)
  78.         nKey := InKey(0)
  79.         IF !StdMeth(nKey, oTbrSched)
  80.           DO CASE
  81.             CASE nKey == K_ESC
  82.               lExitRequested := .T.
  83.     
  84.             CASE nKey == K_ENTER
  85.               AddStudents(Sched -> SemId)
  86.           ENDCASE
  87.         ENDIF
  88.       ENDDO
  89.     
  90.     RETURN NIL
  91.     
  92.     
  93.     FUNCTION AddStudents(cSemId)
  94.     
  95.     LOCAL oTbrStudents
  96.     LOCAL cSaveScr
  97.     LOCAL nSaveSel
  98.     LOCAL bFirst := {|| Students -> (DbSeek(cSemId)) }
  99.     LOCAL bLast  := {|| Students -> (DbSeek(INCLAST(cSemId), .T.)), ;
  100.                         Students -> (DbSkip(-1)) }
  101.     LOCAL bFor   := {|| .T. }
  102.     LOCAL bWhile := {|| Students -> SemId == cSemId }
  103.     LOCAL nSaveSelect := Select()
  104.     LOCAL lExitRequested := .F.
  105.     LOCAL nKey
  106.     LOCAL oTbc
  107.     LOCAL cClassname
  108.     
  109.       SELECT Students
  110.     
  111.       oTbrStudents := TBfwaBrowse(bWhile, bFor, bFirst, bLast)
  112.     
  113.       // Automatic apppend mode
  114.       APPEND_MODE(oTbrStudents, .T.)
  115.     
  116.       oTbrStudents:nTop    := 12
  117.       oTbrStudents:nLeft   := 1
  118.       oTbrStudents:nBottom := MaxRow() - 1
  119.       oTbrStudents:nRight  := MaxCol() - 1
  120.       oTbrStudents:colSep  := DEF_CSEP
  121.       oTbrStudents:headSep := DEF_HSEP
  122.     
  123.       // Make get / set blocks so we can edit them
  124.       oTbc := TBColumnNew("Last Name", ;
  125.                           {|cLname| iif(cLname == NIL, ;
  126.                                     Students -> Lname,  ;
  127.                                     Students -> Lname := cLname) })
  128.       oTbrStudents:addColumn(oTbc)
  129.     
  130.       oTbc := TBColumnNew("First Name", ;
  131.                           {|cFname| iif(cFname == NIL, ;
  132.                                     Students -> Fname,  ;
  133.                                     Students -> Fname := cFname) })
  134.       oTbrStudents:addColumn(oTbc)
  135.     
  136.       oTbc := TBColumnNew("Telephone", ;
  137.                           {|cTel| iif(cTel == NIL,    ;
  138.                                       Students -> Tel, ;
  139.                                       Students -> Tel := cTel) })
  140.       oTbrStudents:addColumn(oTbc)
  141.     
  142.       cSaveScr := SaveScreen(11, 0, MaxRow(), MaxCol())
  143.       Classes -> (DbSeek(Sched -> ClassId))
  144.       BoxMsg(11, 0, MaxRow(), MaxCol(), ;
  145.              " Students for " + Trim(Sched -> City) + " " + ;
  146.              Trim(Classes -> Classname) + " ")
  147.     
  148.       DO WHILE !lExitRequested
  149.         FullStabilize(oTbrStudents)
  150.         nKey := InKey(0)
  151.         IF !Stdmeth(nKey, oTbrStudents)
  152.           DO CASE
  153.             CASE nKey == K_ESC
  154.               lExitRequested := .T.
  155.     
  156.             CASE nKey == K_INS
  157.               oTbrStudents:goBottom()
  158.       
  159.             CASE nKey == K_ENTER
  160.               StudEdit(oTbrStudents, cSemId)
  161.     
  162.             CASE nKey >= 32 .AND. nKey <= 255
  163.               IF oTbrStudents:stable
  164.                 KEYBOARD chr(K_ENTER) + chr(nKey)
  165.               ENDIF
  166.           ENDCASE
  167.         ENDIF
  168.       ENDDO
  169.     
  170.       RestScreen(11, 0, MaxRow(), MaxCol(), cSaveScr)
  171.       SELECT (nSaveSelect)
  172.     
  173.     RETURN NIL
  174.     
  175.     
  176.     FUNCTION BoxMsg(nT, nL, nB, nR, cMessage)
  177.     
  178.     LOCAL nSpare
  179.     
  180.       nSpare := (nR - nL + 1) - Len(cMessage)
  181.     
  182.       @ nT, nL TO nB, nR
  183.       @ nT, nL + Int(nSpare / 2) SAY cMessage
  184.     
  185.     RETURN NIL
  186.     
  187.     
  188.     FUNCTION StudEdit(oTbrStudents, cSemId)
  189.     
  190.     FIELD SemId, Lname, Fname IN Students
  191.     
  192.     LOCAL aFvals := Array(oTbrStudents:rightVisible)
  193.     LOCAL aCols := TbcColPos(oTbrStudents)
  194.     LOCAL i
  195.     LOCAL cOldKeyVal, cNewKeyVal, bFldGsb, lSaveCurs
  196.     
  197.       FOR i := oTbrStudents:leftVisible TO oTbrStudents:rightVisible
  198.         aFvals[i] := Eval(oTbrStudents:getColumn(i):Block)
  199.         @ Row(), aCols[i] GET aFvals[i]
  200.       NEXT
  201.     
  202.     //  cOldKeyVal := &(Indexkey())
  203.       cOldKeyVal := Upper(SemId + Lname + Fname)
  204.       lSaveCurs := Set(_SET_CURSOR, SC_NORMAL)
  205.       READ
  206.       Set(_SET_CURSOR, lSaveCurs)
  207.       IF Updated() .AND. LastKey() != K_ESC
  208.         IF Eof()
  209.           APPEND BLANK
  210.           DO WHILE NetErr()
  211.             APPEND BLANK
  212.           ENDDO
  213.           // Persistent append mode ...
  214.     //      KEYBOARD Chr(K_INS) + Chr(K_ENTER)
  215.         ELSE
  216.           DO WHILE !Rlock()
  217.           ENDDO
  218.         ENDIF
  219.     
  220.         // Now update all fields
  221.         FOR i := oTbrStudents:leftVisible TO oTbrStudents:rightVisible
  222.           // tbColumn's block instance var is a get / set block
  223.           bFldGsb := oTbrStudents:getColumn(i):block
  224.           Eval(bFldGsb, aFvals[i])
  225.         NEXT
  226.         REPLACE Students -> SemId WITH Sched -> SemId
  227.         UNLOCK
  228.     //    cNewKeyVal := &(IndexKey())
  229.         cNewKeyVal := Upper(SemId + Lname + Fname)
  230.         IF cOldKeyVal != cNewKeyVal
  231.           DbStabilize(oTbrStudents)
  232.         ELSE
  233.           oTbrStudents:refreshCurrent()
  234.         ENDIF
  235.       ELSE
  236.         oTbrStudents:refreshCurrent()
  237.       ENDIF
  238.     
  239.     RETURN NIL
  240.