home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a065 / 1.img / TBEXS.EXE / TBEX20.PRG < prev    next >
Encoding:
Text File  |  1992-03-18  |  6.9 KB  |  245 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 i
  193.     LOCAL cOldKeyVal, cNewKeyVal, bFldGsb, lSaveCurs
  194.     LOCAL cLname := Students -> Lname, ;
  195.           cFname := Students -> Fname, ;
  196.           cTel   := Students -> Tel
  197.  
  198.     LOCAL cSaveScr := SaveScreen(10, 10, 20, 70)
  199.  
  200.       @ 10, 10 CLEAR TO 20, 70
  201.       @ 11, 11 TO 19, 69
  202.       @ 13, 13 SAY " Last name" GET cLname
  203.       @ 14, 13 SAY "First name" GET cFname
  204.       @ 15, 13 SAY " Telephone" GET cTel
  205.       lSaveCurs := Set(_SET_CURSOR, SC_NORMAL)
  206.       READ
  207.       Set(_SET_CURSOR, lSaveCurs)
  208.       RestScreen(10, 10, 20, 70, cSaveScr)
  209.  
  210.       IF Updated() .AND. LastKey() != K_ESC
  211.         IF Eof()
  212.           APPEND BLANK
  213.           DO WHILE NetErr()
  214.             APPEND BLANK
  215.           ENDDO
  216.           // Persistent append mode ...
  217.           KEYBOARD Chr(K_INS) + Chr(K_ENTER)
  218.         ELSE
  219.           DO WHILE !Rlock()
  220.           ENDDO
  221.         ENDIF
  222.  
  223.         REPLACE Students -> Lname WITH cLname, ;
  224.                 Students -> Fname WITH cFname, ;
  225.                 Students -> Tel   WITH cTel
  226.     
  227.         REPLACE Students -> SemId WITH Sched -> SemId
  228.         UNLOCK
  229.     //    cNewKeyVal := &(IndexKey())
  230.         cNewKeyVal := Upper(SemId + Lname + Fname)
  231.         IF cOldKeyVal != cNewKeyVal
  232.           IF Lastrec() != RecNo()
  233.             DbStabilize(oTbrStudents)
  234.           ELSE
  235.             FullStabilize(oTbrStudents)
  236.           ENDIF
  237.         ELSE
  238.           oTbrStudents:refreshCurrent()
  239.         ENDIF
  240.       ELSE
  241.         oTbrStudents:refreshCurrent()
  242.       ENDIF
  243.     
  244.     RETURN NIL
  245.