home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / FOXPRO / TABLES / TBLSRC / TABLE.PRG < prev    next >
Text File  |  1992-11-11  |  7KB  |  285 lines
  1. * Program   :table.prg
  2. * Author    :Mark D. Miller
  3. * Date      :03-Aug-1992
  4. * Notice    : Copyright (c) 03-Aug-1992 by Mark D. Miller
  5. *             All Rights Reserved.
  6. * Notes     :See if I can implement table fields!!!
  7.  
  8.  
  9. #INCLUDE IO.HDR
  10. #INCLUDE KEYS.HDR
  11. #INCLUDE FILEIO.HDR
  12. #INCLUDE STRING.HDR
  13. #INCLUDE COLORS.HDR
  14. #INCLUDE PICK.HDR
  15. #INCLUDE WARN.HDR
  16.  
  17. *
  18. * Global Memory
  19. *
  20. VARDEF
  21.     CHAR( 12 )    OpenTableName
  22.     FILE        OpenTableHandle
  23.     CHAR( 1 )     SEX
  24.     CHAR( 11 )      box_ = "▓▓▓▓▓▓▓▓▓▓▓"
  25.     UINT        cnt, cnt2,ky
  26.     LONG        p, k
  27.     LOGICAL     PicksInited = .F.
  28.     LOGICAL     NewTableAndEnterPressed = .F.
  29.     INT         TableType
  30. ENDDEF
  31.  
  32. procedure ClearTable
  33. parameters  value char( 8 ) name
  34.     pick_clear(p)
  35.     pick_clear(k)
  36.     OpenTableName = space(12)
  37. endpro
  38.  
  39. function logical InitTable
  40. parameters  value char( 8 ) name
  41.  
  42.     vardef
  43.         CHAR        TableIn
  44.     enddef
  45.     @ 12,1 say "In InitTable"
  46.     *
  47.     * Create Pick list to show entries in.
  48.     *
  49.     OpenTableName = TRIM( name )+".tbl"
  50.     *       @ 8, 1 SAY "Opening table..."+OpenTableName
  51.     IF .NOT. F_OPEN( OpenTableHandle, OpenTableName, &F_READ )
  52.         ?"error: can't find table!"
  53.         RETURN .f.
  54.     ENDIF
  55.  
  56.     *
  57.     * Bypass first line which is comment line (get table type)
  58.     *
  59.     p = PICK_INIT()
  60.     F_GETLN( OpenTableHandle, TableIn )
  61.     TableType = VAL( TableIn )
  62.     *       @ 8, 40 SAY "TableType = "+I_STR( TableType )
  63.     IF TableType = 0 .OR. TableType > 2
  64.         TableType = 1                   && Numerical table
  65.     ENDIF
  66.  
  67.     IF TableType = 2                    && Keyed table
  68.     *           @ 9, 1 SAY "Initing the key pick list"
  69.         k = PICK_INIT()
  70.     ENDIF
  71.  
  72.     *
  73.     * Load the table entries in the pick list
  74.     *
  75.     cnt = 0
  76.     DO WHILE .NOT. F_EOF( OpenTableHandle )
  77.         F_GETLN( OpenTableHandle, TableIn )
  78.         IF TableType = 2
  79.             PICK_ADD( k, LEFT( TableIn, AT( "-", TableIn )-1 ) )
  80.             PICK_ADD( p, SUBSTR( TableIn, AT( "-", TableIn )+1, LEN( TableIn ) ) )
  81.         ELSE
  82.             PICK_ADD( p, TableIn )
  83.         ENDIF
  84.  
  85.         cnt = cnt + 1
  86.     ENDDO
  87.  
  88.     F_CLOSE( OpenTableHandle )
  89.     *       @11, 1 SAY "Completed initializing picks! Cnt ="+i_str(cnt)
  90.     return .t.
  91. endpro
  92.  
  93.  
  94. * Function  :Table
  95. * Date      :03-Aug-1992
  96. * Parameters:name           Name of table
  97. *           :tlr            Top Left Row of Window
  98. *           :tlc            Top Left Column of Window
  99. *           :rows           Number of items to display at once
  100. *           :length         Max Length of table strings
  101. *           :pkey           Key into PickList
  102. *           :
  103. * Return Val:ky             Key pressed
  104. *           :
  105. * Notes     :This routine opens the correct table file and looks up the value
  106. *            in the file.
  107. *
  108. FUNCTION UINT Table
  109.     PARAMETERS  CONST   CHAR( 8 ) name,;
  110.                 VALUE   INT     tlr,;
  111.                 VALUE   INT     tlc,;
  112.                 VALUE   INT     rows,;
  113.                 VALUE   INT     length,;
  114.                         CHAR( 4 ) pkey
  115.  
  116.     VARDEF
  117.         UINT        s
  118.         LOGICAL     fnd
  119.         INT         ttlr
  120.         INT         ttlc
  121.         INT         brr
  122.         INT         brc
  123.         INT         rc
  124.         CHAR( 4 )     mykey
  125.         INT         l
  126.     ENDDEF
  127.  
  128.     ky = LASTKEY()
  129.     IF ky <> &K_TAB
  130.         RETURN ky
  131.     ENDIF
  132.     *
  133.     * Init the table if not already
  134.     *
  135.     @ 11,0 say ">"+Name+"< >"+OpenTableName+"<"
  136.     if at(Name,OpenTableName) = 0
  137.         if .not. InitTable(Name)
  138.             return 0
  139.         endif
  140.     endif
  141.  
  142.     *
  143.     * Set up window coords
  144.     *
  145.     ttlr = tlr
  146.     ttlc = tlc
  147.     IF ttlr = 0
  148.         ttlr = 1
  149.     ENDIF
  150.  
  151.     IF ttlc = 0
  152.         ttlc = 1
  153.     ENDIF
  154.  
  155.     brr = ( ttlr + rows )-1
  156.     brc = ttlc + length
  157.     IF brr+2 > 23
  158.         brr = 21
  159.     ENDIF
  160.  
  161.     IF brc+4 > 78
  162.         brc = 74
  163.     ENDIF
  164.  
  165.     *       ?? ttlr, ttlc, brr, brc
  166.     *       @12, 1 SAY "preparing to display picks"
  167.     s = SAVESCRN( ttlr-1, ttlc-1, brr+2, brc+2 )  && A little bigger than necessary
  168.     FILL( ttlr-1, ttlc-1, brr+2, brc+2, &SINGLE_BOX, " ", &blue_white, &green_light_grey, 6 )
  169.     PICK_LIST( p, ttlr, ttlc, brr, brc, rc, .F., .F. )
  170.     KEY_INT( &K_HOME )
  171.     KEY_INT( &K_DEL )
  172.     KEY_INT( &K_DEL )
  173.     KEY_INT( &K_DEL )
  174.     KEY_INT( &K_DEL )
  175.     IF TableType = 1
  176.         pkey = I_STR( rc )
  177.         KEYBOARD( pkey )
  178.     ELSE
  179.         pkey = PICK_STR( k, rc )
  180.         KEYBOARD( pkey )                && Get the chosen value
  181.     ENDIF
  182.  
  183.     RESTORESCRN( s )
  184.     *       @13, 1 SAY "returning to get!"
  185.     RETURN &K_HOME
  186. ENDPRO
  187.  
  188. FUNCTION LOGICAL VerifyTable
  189.     PARAMETERS VALUE CHAR( 8 )  name,;
  190.                value int        row,;
  191.                value int        col,;
  192.                value int        length,;
  193.                VALUE CHAR( 4 )  pkey
  194.  
  195.     VARDEF
  196.         CHAR        TableIn
  197.         LOGICAL     fnd
  198.         CHAR( 4 )     pkey2, mykey
  199.         INT         l
  200.     ENDDEF
  201.  
  202.     *
  203.     * Init the table if not already
  204.     *
  205.     if at(Name,OpenTableName) = 0
  206.         if .not. InitTable(Name)
  207.             return .t.
  208.         endif
  209.     endif
  210.  
  211.     pkey2=TRIM( pkey )
  212.     IF pkey2=""
  213.         @ row,col clear to row,col+length
  214.         if ky = &K_ENTER .or. ky = &K_ESC .or. ky = &K_C_END .or. (ky > &K_HOME .and. ky < &K_INS)
  215.                 ClearTable(Name)
  216.         endif
  217.         RETURN .T.                      && Always allow to skip field
  218.     ENDIF
  219.  
  220.     *
  221.     * Validate the choice against the list
  222.     *
  223.     IF TableType = 1
  224.         if i_val(pkey2)=0
  225.             fnd=.f.
  226.         else
  227.             IF I_VAL( pkey2 ) > cnt
  228.                 fnd= .F.
  229.             ELSE
  230.                 @ row,col clear to row,col+length
  231.                 @row,col ?? pick_str(p,i_val(pkey2))
  232.                 fnd = .T.
  233.             ENDIF
  234.         endif
  235.     ELSE
  236.         cnt2 = 1
  237.         fnd = .F.
  238.         DO WHILE cnt2 < cnt+1 .AND. .NOT. fnd
  239.             mykey = PICK_STR( k, cnt2 )
  240.             L = LEN( mykey )
  241.             IF LEFT( pkey2, L ) = mykey
  242.                 fnd = .T.
  243.                 @ row,col clear to row,col+length
  244.                 @row,col ?? pick_str(p,cnt2)
  245.             ENDIF
  246.  
  247.             cnt2 = cnt2 + 1
  248.         ENDDO
  249.  
  250.     ENDIF
  251.  
  252.     IF .NOT. fnd
  253.         @ 18, 1
  254.         WAIT CHR( 7 )+"Table error!!! Press TAB for choices!"
  255.     else
  256.         if ky = &K_ENTER .or. ky = &K_ESC .or. ky = &K_C_END .or. (ky > &K_HOME .and. ky < &K_INS)
  257.                 ClearTable(Name)
  258.         endif
  259.     ENDIF
  260.  
  261.     RETURN fnd
  262. ENDPRO
  263.  
  264. PROCEDURE FORCE_MAIN
  265.  
  266.     VARDEF
  267.         CHAR( 10 )    fname
  268.         INT         age
  269.     ENDDEF
  270.  
  271.     SET CONFIRM ON
  272.     CLEAR
  273.     *FILL( 0, 0, 25, 80, box_, box_, 15, 15, 0 )
  274.  
  275.     @ 1, 1 SAY "First Name    : " GET fname
  276.     @ 3, 1 SAY "table value   : " ;
  277.            GET SEX PICTURE "!!"    ;
  278.            FILTER Table( "SEXCODES", 3, 30, 5, 15, SEX ) ;
  279.            VALID VerifyTable( "SEXCODES", 3, 22, 15, SEX )
  280.  
  281.     @ 5, 1 SAY "Your Age      : " GET age PICTURE "999"
  282.     READ
  283.  
  284. ENDPRO
  285.