home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / BASIC / PROGEN / PROSRC.ZIP / PROSCN71.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-10-09  |  65.0 KB  |  1,953 lines
  1. DECLARE SUB nodatafile ()
  2. DECLARE SUB dialogtwo (dialog$(), first$, lenfirst%, second$, lensecond%)
  3.   DECLARE SUB buildscreen ()
  4.   DECLARE SUB clearscreen ()
  5.   DECLARE SUB createdatafile ()
  6.   DECLARE SUB DispRecField (temp AS ANY)
  7.   DECLARE SUB initindex ()
  8.   DECLARE SUB RecFieldselect (indexnum%, key$, MastRec%, IndexRec%, exitcode%)
  9.   DECLARE SUB seldatafile ()
  10.   DECLARE SUB mainscreen ()
  11.   DECLARE SUB nodata ()
  12.   DECLARE FUNCTION strval$ (a%)
  13.   DECLARE SUB PIM (cmd$, indexnum%, key$, MastRec%, CurrentIndexREC%)
  14.   DECLARE SUB PIMClose (indexnum%, file$)
  15.   DECLARE SUB PIMCreate (indexnum%, file$, keylength%, mfile$)
  16.   DECLARE SUB PIMdelkey (IxNum%, temp$, MastRec%, IndexRec%)
  17.   DECLARE SUB PIMOpen (indexnum%, file$)
  18.   DECLARE SUB formatinfo ()
  19.   DECLARE SUB proginfo1 ()
  20.   DECLARE SUB proginfo2 ()
  21.   DECLARE SUB PROBRO.1 ()
  22.   DECLARE FUNCTION PIMstats% (indexnum%)
  23.   
  24.   DEFINT A-Z
  25.   
  26.   '         Microsoft BASIC 7.1, Professional Development System
  27.   '            Copyright (C) 1987-1989, Microsoft Corporation
  28.   '
  29.   '         Microsoft QBX 7.1, Professional Development System
  30.   '            Copyright (C) 1987-1989, Microsoft Corporation
  31.   '
  32.   '         PROSCN71.bas, PROSCN71.qlb and source are Copyrighted (c)
  33.   '            1991 by: Raymond E Dixon
  34.   '
  35.   '                  Raymond E Dixon
  36.   '                  11660 VC JOHNSON RD.
  37.   '                  Jacksonville, Fl. 32218
  38.   '
  39.   '                  (904) 765-4048
  40.   TYPE RecordType
  41.     status      AS STRING * 1  'First element is in use flag
  42.     Num         AS STRING * 3
  43.     name        AS STRING * 16  '(in order for alphabetical sort)
  44.     type        AS STRING * 1
  45.     case        AS STRING * 1
  46.     key         AS STRING * 1
  47.     decimal     AS STRING * 2
  48.     length      AS STRING * 2
  49.     format      AS STRING * 50
  50.     erow        AS STRING * 2
  51.     ecol        AS STRING * 2
  52.     progname    AS STRING * 8
  53.     comment     AS STRING * 30
  54.     recnum      AS INTEGER
  55.     DUM         AS STRING * 14
  56.     END TYPE
  57.     
  58.     COMMON SHARED MASTERFILE$, numberoffields, ff, progfile$, startp
  59.     OPTION BASE 0
  60.     
  61.     ' $INCLUDE: 'PROLIB71.BI'
  62.     STACK 4000
  63.     '$DYNAMIC
  64.     DIM SHARED scrnline$(25)  ' Lines 1-24
  65.     DIM SHARED RecField AS RecordType
  66.     DIM SHARED formatsel1$(16)
  67.     DIM SHARED formatsel2$(16)
  68.     DIM SHARED fieldpointer%(26, 81)  ' Field input markers
  69.     DIM SHARED fieldpos%(50, 10, 2)  ' Field pos markers
  70.     DIM SHARED fl$(70)
  71.     DIM SHARED dialog$(20)
  72.     DIM SHARED omenu$(10)
  73.     DIM SHARED TestRecField AS RecordType
  74.     DIM SHARED DispLine$(30)
  75.     DIM SHARED Findex(50) AS RecordType
  76.     
  77.     fg = WHITE
  78.     bg = BLUE
  79.     rev = RED
  80.     
  81.     LOCATE 25, 1, 0, 0, 0
  82.     COLOR WHITE, BLUE
  83.     
  84.     CONST RecFieldNameIDX = 1
  85.     CONST RecFieldNumIDX = 2
  86.     CONST datfile = 3
  87. REDO:
  88.     mainscreen
  89.     MsgLine "Press  " + CHR$(24) + " for last " + CHR$(25) + " for next  ENTER to select", 25, 0, 7
  90.     
  91.     DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  92.     CenterText "Select Program Database", 22, BLACK, WHITE
  93.     
  94.  
  95.           fl$ = "SAMPLE PROGRAM\"
  96.     fl$ = fl$ + "USER   PROGRAM\"
  97.     fl$ = fl$ + "NEW    PROGRAM\"
  98.     
  99.     Dopt = MenuWindow(0, 0, fl$, "SELECT ", BLACK, WHITE, RED, 0)
  100.     
  101.     'Get the option
  102.     
  103.     SELECT CASE Dopt  'Select on choice
  104.       CASE 1
  105.         MASTERFILE$ = "SAMPLE.FLD"
  106.       CASE 2
  107.         seldatafile
  108.       CASE 3
  109.         CLOSE
  110.         RUN "progen71"
  111.       CASE ELSE
  112.     END SELECT
  113.     
  114.     IF MASTERFILE$ = "" THEN
  115.       GOTO REDO
  116.     END IF
  117.     
  118. NEWFILE:
  119.     
  120.     IF FileExists(MASTERFILE$) = 0 THEN  'If no index then create
  121.     GOTO REDO
  122.     
  123.     ELSE
  124.  
  125.     PIMOpen RecFieldNameIDX, MASTERFILE$  'Open Index
  126.     PIMOpen RecFieldNumIDX, MASTERFILE$  'Open Index
  127.     
  128.     OPEN MASTERFILE$ FOR RANDOM AS datfile LEN = LEN(RecField)  'Open the data file
  129.     
  130.     initindex
  131.     delimit = INSTR(MASTERFILE$, ".")
  132.     
  133.     IF delimit THEN
  134.       RecField.progname = LEFT$(MASTERFILE$, delimit - 1)
  135.     ELSE
  136.       RecField.progname = MASTERFILE$
  137.     END IF
  138.     progfile$ = LEFT$(MASTERFILE$, delimit - 1)
  139.     DO
  140.       CALL buildscreen
  141.     EXIT DO
  142.     LOOP
  143.     CLOSE
  144.     GOTO REDO
  145.     END IF
  146.     END
  147.  
  148. REM $STATIC
  149.     SUB buildscreen
  150.       
  151.       fg% = WHITE
  152.       bg% = BLUE
  153.       rev% = RED
  154.       FrmFG = BLACK
  155.       FrmBG = WHITE
  156.       GenFG = BLACK
  157.       GenBG = WHITE
  158.       DispPos = 1
  159.       LOCATE , , 0
  160.       CLS
  161.       DrawBox 1, 1, 80, 25, 0, WHITE, BLUE, 1, WHITE, BLUE, 0
  162.       
  163.       fgm% = WHITE
  164.       bgm% = BLACK
  165.       clearscreen
  166.       ins$ = "Off"
  167.       x% = 1
  168.       y% = 1
  169.       xmin% = 1
  170.       xmax% = 80
  171.       ymin% = 1
  172.       ymax% = 25
  173.       
  174.       lup% = 0
  175.       lsch% = 32     ' Last special alternate character
  176.       editmode% = 0  ' Currently in NODRAW mode
  177.       
  178.       WHILE lup% = 0
  179.         
  180.         IF fieldpointer%(y%, x%) THEN
  181.           modemsg$ = "F3 = Disp Info :"
  182.           fieldset% = 1
  183.         ELSE
  184.           modemsg$ = "           "
  185.           fieldset% = 0
  186.         END IF
  187.         
  188.         IF editmode% = 1 THEN
  189.           modemsg$ = "Draw      "
  190.           IF drawvertlin% = 1 THEN
  191.             modemsg$ = modemsg$ + "Vert Line"
  192.           END IF
  193.           IF drawhorzlin% = 1 THEN
  194.             modemsg$ = modemsg$ + "Horz Line"
  195.           END IF
  196.           IF drawboxlin% = 1 THEN
  197.             modemsg$ = modemsg$ + "Box      "
  198.           END IF
  199.         END IF
  200.         
  201.         menop% = 0
  202.         menu% = 0
  203.         
  204.         IF fieldset% THEN
  205.           
  206.           fp% = fieldpointer%(y%, x%)
  207.           IF fp% THEN
  208.             GET #datfile, fp%, RecField
  209.             fid$ = RecField.name
  210.           END IF
  211.         ELSE
  212.           fid$ = "                 "
  213.         END IF
  214.         
  215.         optex1$ = " ESC = cmds Ins=" + ins$ + "  " + modemsg$ + fid$
  216.         optex2$ = "Col = " + strval$(x%) + " "
  217.         optex3$ = "Row = " + strval$(y%) + " "
  218.         
  219.         CALL pnc(STRING$(80, " "), 25, 1, BLACK, WHITE)
  220.         CALL pnc(optex1$, 25, 1, BLACK, WHITE)
  221.         CALL pnc(optex3$, 25, 58, BLACK, WHITE)
  222.         CALL pnc(optex2$, 25, 69, BLACK, WHITE)
  223.         
  224.         LOCATE y%, x%, 1, 0, 15  ' Display the cursor
  225.         
  226.         CALL GetSingle(ch%, ctype%)
  227.         
  228.         SELECT CASE ctype%
  229.           CASE 1
  230.             
  231.             SELECT CASE ch%
  232.                 
  233.               CASE 27  ' Repeat last Alternate Character
  234.                 
  235.                 LOCATE , , 0, 0
  236.                  dialog$(1) = "Function Key Commands"
  237.                  dialog$(2) = ""
  238.                  dialog$(3) = "F1 = COMMAND Menu         " + CHR$(255)
  239.                  dialog$(4) = "F2 = Insert  Field        " + CHR$(255)
  240.                  dialog$(5) = "F3 = Display Field Info   " + CHR$(255)
  241.                  dialog$(6) = "F4 = Delete  Field Info   " + CHR$(255)
  242.                  dialog$(7) = "F5 = Insert  Special Field" + CHR$(255)
  243.                  dialog$(8) = "F6 = Display Special Field" + CHR$(255)
  244.                  dialog$(9) = "F7 = Delete  Special Field" + CHR$(255)
  245.                 dialog$(10) = "F8 = Select ASC Char      " + CHR$(255)
  246.                 dialog$(11) = "F9 = Print  ASC Char      " + CHR$(255)
  247.                 dialog$(12) = ""
  248.                 dialog$(13) = "any key to return"
  249.                 
  250.                 CALL Message(dialog$(), 13, 2, FrmFG, FrmBG, GenFG, GenBG)
  251.                 
  252.             END SELECT
  253.             
  254.           CASE 2
  255.             
  256.             SELECT CASE ch%
  257.                 
  258.               CASE 59
  259.                 LOCATE , , 0
  260.                 DO
  261.                   menu$ = "1 - File\2 - Edit\3 - Draw\4 - Color Setup\5 - Exit\"
  262.                   
  263.                   omenu$(1) = "1 - Load\2 - Save\3 - Change Progran\4 - Gen Sub\5 - Default Screen\"
  264.                   omenu$(2) = "1 - Copy of above line\2 - Center Line\3 - Insert Blank Line\4 - Delete Line\5 - Insert Column\6 - Delete Column\7 - Find & Replace\8 - Clear\"
  265.                   omenu$(3) = "1 - Box\2 - Vertical Line\3 - Horizontal Line\"
  266.                   omenu$(5) = "1 - To Editor\2 - To PROGEN\3 - To PRORPT\4 - To DOS"
  267.                   omenu$(4) = "1 - Define Attributes\"
  268.                   
  269.                   menu% = MenuWindow%(row%, col%, menu$, "Main Menu", BLACK, WHITE%, RED, 0)
  270.                   menop% = MenuWindow%(row%, col%, omenu$(menu%), "Menu", BLACK, WHITE%, RED, 1)
  271.                   
  272.                 LOOP WHILE menop% = 0
  273.                 prvmen% = menu%
  274.                 prvop% = menop%
  275.                 
  276.                 SELECT CASE menu%
  277.                   CASE 1
  278.                     SELECT CASE menop%
  279.                       CASE 1  ' Load a file
  280.                         clearscreen
  281.  
  282.                         OPT$ = "*.SCR"
  283.                         OPT$ = SelFiles(OPT$)
  284.                         ff = FREEFILE
  285.                         IF LEN(OPT$) THEN
  286.                           TEST$ = LEFT$(OPT$, INSTR(OPT$, ".") - 1)
  287.  
  288.                         IF FileExists(TEST$ + ".fld") <> 0 THEN 'If no index then create
  289.  
  290.                           OPEN "r", ff, OPT$, 80
  291.                           OPT$ = LEFT$(OPT$, INSTR(OPT$, ".") - 1)
  292.                           FIELD #ff, 80 AS s1$
  293.                           FOR j% = 1 TO 25
  294.                             GET #ff, j%
  295.                             scrnline$(j%) = s1$
  296.                           NEXT j%
  297.                             GET #ff, 26
  298.                             Trim s1$
  299.                             MASTERFILE$ = s1$
  300.                           CLOSE ff
  301.                         IF LEN(MASTERFILE$) THEN
  302.                         CLOSE datfile
  303.                         OPEN MASTERFILE$ FOR RANDOM AS datfile LEN = LEN(RecField)  'Open the data file
  304.                         END IF
  305.                         initindex
  306.  
  307.                         ELSE
  308.                         CALL nodatafile
  309.                         END IF
  310.                         END IF
  311.                           FOR j% = 1 TO 25
  312.                             pnc scrnline$(j%), j%, 1, fg%, bg%
  313.                           NEXT j%
  314.  
  315.                       CASE 2  ' Save a file
  316.                         
  317.                         LOCATE , , 0, 0
  318.                         dialog$(1) = "Save this Screen as ..."
  319.                         dialog$(2) = ""
  320.                         fil1$ = progfile$
  321.                         l1% = 8
  322.                         CALL DialogBox(dialog$(), 2, 0, l1%, FrmFG, FrmBG, GenFG, GenBG, DispPos, fil1$, "########", Ek)
  323.                         CALL Trim(fil1$)
  324.                         IF LEN(fil.1$) THEN
  325.                           ffs = FREEFILE
  326.                           OPEN "r", ffs, fil.1$ + ".SCR", 80
  327.                           FIELD #ffs, 80 AS s1$
  328.                           FOR j% = 1 TO 25
  329.                             LSET s1$ = scrnline$(j%)
  330.                             PUT #ffs, j%
  331.                           NEXT j%
  332.                             LSET s1$ = MASTERFILE$
  333.                             PUT #ffs, 26
  334.                           CLOSE ff
  335.  
  336.                         END IF
  337.                         
  338.                       CASE 3  ' change program
  339.                        EXIT SUB
  340.                         
  341.                       CASE 4  ' Generate screen
  342.                         LOCATE , , 0, 0
  343.                         dialog$(1) = "Screen sub to create is ..."
  344.                         dialog$(2) = ""
  345.                         fil.1$ = STRING$(8, 32)
  346.                         l1% = 8
  347.                         
  348.                         CALL DialogBox(dialog$(), 2, 0, l1%, FrmFG, FrmBG, GenFG, GenBG, DispPos, fil.1$, "########", Ek)
  349.                         ffg = FREEFILE
  350.                         CALL Trim(fil.1$)
  351.                         OPEN "o", ffg, fil.1$ + ".bas"
  352.                         LOCATE , , 0, 0
  353.                         dialog$(1) = "Title this program ..."
  354.                         dialog$(2) = ""
  355.                         format$ = STRING$(50, "#")
  356.                         CALL DialogBox(dialog$(), 2, 0, 50, FrmFG, FrmBG, GenFG, GenBG, DispPos, tit$, format$, Ek)
  357.                         
  358.                         CALL Trim(tit$)
  359.                         PRINT #ffg, "  sub " + fil.1$ + ".frame static"
  360.                         
  361.                         FOR j% = 1 TO 25
  362.                           w$ = scrnline$(j%)
  363.                           CALL Trim(w$)
  364.                           IF LEN(w$) THEN
  365.                             w% = INSTR(scrnline$(j%), w$)
  366.                             PRINT #ffg, "        pnc " + CHR$(34) + w$ + CHR$(34) + "," + strval$(j%) + "," + strval$(w%) + ",fg,bg"
  367.                           END IF
  368.                         NEXT j%
  369.                         PRINT #ffg, "  end sub ' " + fil.1$
  370.                         CLOSE ffg
  371.                         
  372.                       CASE 5  ' DEFAULT SCREEN
  373.                         
  374.                         clearscreen
  375.                         initindex
  376.                         startp = 12 - (numberoffields \ 2)
  377.                         
  378.                         FOR j% = 1 TO numberoffields
  379.                           
  380.                           w$ = Findex(j%).name
  381.                           F$ = Findex(j%).ecol
  382.                           T$ = Findex(j%).erow
  383.                           d$ = w$ + ":"
  384.                           
  385.                           CALL Trim(w$)
  386.                           CALL Trim(F$)
  387.                           CALL Trim(T$)
  388.                           
  389.                           IF LEN(w$) THEN
  390.                             
  391.                             scrnline$(startp + j%) = STRING$(80, " ")
  392.                             
  393.                             MID$(scrnline$(startp + j%), 4, 18) = d$
  394.                             MID$(scrnline$(startp + j%), 22, LEN(RTRIM$(Findex(j%).format))) = STRING$(LEN(RTRIM$(Findex(j%).format)), CHR$(219))
  395.                             fl$ = Findex(j%).format
  396.                             Trim fl$
  397.                             
  398.                             FOR fp% = 22 TO 22 + LEN(fl$) - 1
  399.                               fieldpointer%(startp + j%, fp%) = Findex(j%).recnum
  400.                             NEXT
  401.                             
  402.                             Findex(j%).erow = strval$(startp + j%)
  403.                             Findex(j%).ecol = strval$(22)
  404.                             
  405.                             PUT #datfile, Findex(j%).recnum, Findex(j%)
  406.                             
  407.                           END IF
  408.                         NEXT j%
  409.                         
  410.                         filespec$ = MASTERFILE$
  411.                         delimit = INSTR(filespec$, ".")
  412.                         
  413.                         IF delimit THEN
  414.                           FileName$ = LEFT$(filespec$, delimit - 1)
  415.                           fileext$ = RIGHT$(filespec$, LEN(filespec$) - (delimit))
  416.                         ELSE
  417.                           FileName$ = filespec$
  418.                           fileext$ = ".BAS"
  419.                         END IF
  420.                         
  421.                         fil.1$ = FileName$
  422.                         
  423.                         CALL Trim(fil.1$)
  424.                         
  425.                         IF LEN(fil.1$) THEN
  426.                           ffd = FREEFILE
  427.                           OPEN "r", ffd, fil.1$ + ".SCR", 80
  428.                           FIELD #ffd, 80 AS s1$
  429.                           FOR j% = 1 TO 25
  430.                             
  431.                             LSET s1$ = scrnline$(j%)
  432.                             PUT #ffd, j%
  433.                             
  434.                           NEXT j%
  435.                           CLOSE ffd
  436.                           
  437.                           FOR j% = 1 TO 25
  438.                             pnc scrnline$(j%), j%, 1, fg%, bg%
  439.                           NEXT j%
  440.                         END IF
  441.                         
  442.                     END SELECT  'menu option 1
  443.                     
  444.                   CASE 2
  445.                     
  446.                     SELECT CASE menop%
  447.                         
  448.                       CASE 1  ' Copy above line
  449.  
  450.                         scrnline$(y%) = scrnline$(y% - 1)
  451.                         CALL pnc(scrnline$(y%), y%, 1, fg%, bg%)
  452.                         y% = y% + 1
  453.                         
  454.                       CASE 2  ' Centre line
  455.  
  456.                         CALL Trim(scrnline$(y%))
  457.                         scrnline$(y%) = STRING$((80 - LEN(scrnline$(y%))) / 2, 32) + scrnline$(y%)
  458.                         scrnline$(y%) = scrnline$(y%) + STRING$(80 - LEN(scrnline$(y%)), 32)
  459.                         CALL pnc(scrnline$(y%), y%, 1, fg%, bg%)
  460.                         
  461.                       CASE 3  ' Insert line
  462.  
  463.                         FOR j% = 25 TO y% + 1 STEP -1
  464.                           scrnline$(j%) = scrnline$(j% - 1)
  465.                         NEXT j%
  466.                         scrnline$(y%) = STRING$(80, 32)
  467.                         FOR j% = 25 TO y% STEP -1
  468.                           CALL pnc(scrnline$(j%), j%, 1, fg%, bg%)
  469.                         NEXT j%
  470.                         
  471.                       CASE 4  ' Delete line
  472.                         
  473.                         FOR j% = y% TO 23
  474.                           scrnline$(j%) = scrnline$(j% + 1)
  475.                         NEXT j%
  476.                         scrnline$(25) = STRING$(80, 32)
  477.                         FOR j% = y% TO 25
  478.                           CALL pnc(scrnline$(j%), j%, 1, fg%, bg%)
  479.                         NEXT j%
  480.                         
  481.                         FOR j% = y% TO 23
  482.                           FOR k% = 1 TO 80
  483.                             fieldpointer%(j%, k%) = fieldpointer%(j% + 1, k%)
  484.                           NEXT k%
  485.                         NEXT j%
  486.                         
  487.                         FOR k% = 1 TO 80
  488.                           fieldpointer%(j% + 1, k%) = 0
  489.                           fieldpointer%(25, k%) = 0
  490.                         NEXT k%
  491.                         GOSUB updateREC
  492.                         
  493.                       CASE 5  ' Insert column
  494.  
  495.                         ch% = 32  ' Character to insert
  496.                         xs% = x% - 1
  497.                         
  498.                         FOR j% = 1 TO 25
  499.                           
  500.                           IF x% = 1 THEN
  501.                             scrnline$(j%) = CHR$(ch%) + MID$(scrnline$(j%), 1, 79)
  502.                           ELSEIF x% = 80 THEN
  503.                             MID$(scrnline$(j%), 80, 1) = CHR$(ch%)
  504.                           ELSEIF (x% > 1 AND x% < 80) THEN
  505.                             pref$ = MID$(scrnline$(j%), 1, x% - 1)
  506.                             post$ = MID$(scrnline$(j%), x%, 79)
  507.                             scrnline$(j%) = pref$ + CHR$(ch%) + post$
  508.                           END IF
  509.                           
  510.                           IF LEN(scrnline$(j%)) > 80 THEN
  511.                             scrnline$(j%) = MID$(scrnline$(j%), 1, 80)
  512.                           END IF
  513.                           
  514.                           CALL pnc(scrnline$(j%), j%, 1, fg%, bg%)
  515.                           
  516.                         NEXT j%
  517.                         
  518.                         FOR j% = 1 TO 25
  519.                           IF INSTR(1, scrnline$(j%), CHR$(219)) THEN
  520.                             FOR k% = 79 TO xs% STEP -1
  521.                               SWAP fieldpointer%(j%, k%), fieldpointer%(j%, k% + 1)
  522.                             NEXT k%
  523.                             GOSUB updateREC
  524.                           END IF
  525.                         NEXT j%
  526.  
  527.                       CASE 6  ' Delete column
  528.                         
  529.                         FOR j% = 1 TO 25
  530.                           
  531.                           IF x% = 1 THEN
  532.                             scrnline$(j%) = MID$(scrnline$(j%), 2, 80) + " "
  533.                           ELSEIF x% = 80 THEN
  534.                             MID$(scrnline$(j%), 80, 1) = " "
  535.                           ELSEIF (x% > 1 AND x% < 80) THEN
  536.                             pref$ = MID$(scrnline$(j%), 1, x% - 1)
  537.                             post$ = MID$(scrnline$(j%), x% + 1, 79)
  538.                             scrnline$(j%) = pref$ + post$ + " "
  539.                           END IF
  540.                           
  541.                           CALL pnc(scrnline$(j%), j%, 1, fg%, bg%)
  542.                         NEXT j%
  543.                         
  544.                         FOR j% = 1 TO 25
  545.                           IF INSTR(1, scrnline$(j%), CHR$(219)) THEN
  546.                             
  547.                             FOR k% = x% TO 79
  548.                               SWAP fieldpointer%(j%, k%), fieldpointer%(j%, k% + 1)
  549.                             NEXT k%
  550.                             GOSUB updateREC
  551.                           END IF
  552.                         NEXT j%
  553.                         
  554.                         FOR k% = 1 TO 25
  555.                           fieldpointer%(k%, 80) = 0
  556.                         NEXT k%
  557.                         
  558.                       CASE 7  ' Find & Replace
  559.                         
  560.                         LOCATE , , 0, 0
  561.                         dialog$(1) = "Find..."
  562.                         dialog$(2) = "and replace it with..."
  563.                         'dialog$(3) = "If items differ in length, the"
  564.                         'dialog$(4) = "line will loose characters)"
  565.                         find$ = STRING$(8, 32)
  566.                         rep$ = STRING$(8, 32)
  567.                         l1% = 8
  568.                         l2% = 8
  569.  
  570.                         CALL dialogtwo(dialog$(), find$, l1%, rep$, l2%)
  571.                         
  572.                         Trim (find$)
  573.                         Trim (rep$)
  574.                         
  575.                         a% = LEN(find$)
  576.                         b% = LEN(rep$)
  577.                         IF a% > b% THEN
  578.                           b% = a%
  579.                         END IF
  580.                         
  581.                         IF LEN(find$) < b% THEN
  582.                           find$ = find$ + STRING$(b% - LEN(find$), 32)
  583.                         END IF
  584.                         
  585.                         IF LEN(rep$) < b% THEN
  586.                           rep$ = rep$ + STRING$(b% - LEN(rep$), 32)
  587.                         END IF
  588.                         
  589.                         FOR j% = 1 TO 25
  590.                           a% = INSTR(scrnline$(j%), find$)
  591.                           c% = 0
  592.                           WHILE a% AND c% < 80
  593.                             MID$(scrnline$(j%), a%, b%) = rep$
  594.                             c% = c% + 1
  595.                             a% = INSTR(scrnline$(j%), find$)
  596.                           WEND
  597.                           CALL pnc(scrnline$(j%), j%, 1, fg%, bg%)
  598.                           
  599.                         NEXT j%
  600.                         
  601.                       CASE 8  ' CLEAR
  602.                         
  603.                         FOR j% = 1 TO 25
  604.                           scrnline$(j%) = STRING$(80, 32)
  605.                           CALL pnc(scrnline$(j%), j%, 1, fg%, bg%)
  606.                           FOR k% = 1 TO 80
  607.                             fieldpointer%(j%, k%) = 0
  608.                           NEXT k%
  609.                         NEXT j%
  610.                         
  611.                     END SELECT  'menu option 2
  612.                     
  613.                   CASE 3  'menu 3
  614.  
  615.                     SELECT CASE menop%
  616.                         
  617.                       CASE 1  ' Draw a BOX
  618.                         LOCATE , , 0, 0
  619.                         dialog$(1) = "To draw a box, move to the opposite"
  620.                         dialog$(2) = "corner and press return, continue?"
  621.                         yn$ = "YyNn"
  622.                         Ques$ = "Y/N"
  623.                         
  624.                         CALL AskQuestion(dialog$(), 2, 2, 1, FrmFG, FrmBG, GenFG, GenBG, Ques$, yn$)
  625.                         
  626.                         IF yn$ = "Y" THEN  ' Yes, a box has been chosen
  627.                           drawboxlin% = 1  ' Turn on box draw
  628.                           editmode% = 1  ' Make allowable input draw only
  629.                           crx% = x%
  630.                           cry% = y%
  631.                         END IF
  632.                         
  633.                       CASE 2  ' Draw a Vertical line
  634.  
  635.                         LOCATE , , 0, 0
  636.                         dialog$(1) = "To draw a line, move to the opposite"
  637.                         dialog$(2) = "end and press return, continue?"
  638.                         Ques$ = "Y/N"
  639.                         yn$ = "YyNn"
  640.                         
  641.                         CALL AskQuestion(dialog$(), 2, 2, 1, FrmFG, FrmBG, GenFG, GenBG, Ques$, yn$)
  642.                         
  643.                         IF yn$ = "Y" THEN  ' Yes, a vertical line has been chosen
  644.                           drawvertlin% = 1  ' Turn on line draw
  645.                           editmode% = 1  ' Make allowable input draw only
  646.                           crx% = x%
  647.                           cry% = y%
  648.                         END IF
  649.                         
  650.                       CASE 3  ' Draw a horizontal line
  651.  
  652.                         LOCATE , , 0, 0
  653.                         dialog$(1) = "To draw a line, move to the opposite"
  654.                         dialog$(2) = "end and press return, continue?"
  655.                         Ques$ = "Y/N"
  656.                         yn$ = "YyNn"
  657.                         
  658.                         CALL AskQuestion(dialog$(), 2, 2, 1, FrmFG, FrmBG, GenFG, GenBG, Ques$, yn$)
  659.                         IF yn$ = "Y" THEN  ' Yes, a horizontal line been chosen
  660.                           drawhorzlin% = 1  ' Turn on line draw
  661.                           editmode% = 1  ' Make allowable input draw only
  662.                           crx% = x%
  663.                           cry% = y%
  664.                         END IF
  665.                     END SELECT  'menu option 3
  666.                     
  667.                   CASE 4  'menu 4 set color
  668.                     
  669.                     CALL GetBackground(1, 1, 25, 80, temp$)
  670.                     CLS
  671.                     CALL PutBackground(1, 1, temp$)
  672.                     trmp$ = ""
  673.                     menop% = 0
  674.                     menu% = 0
  675.                     
  676.                   CASE 5
  677.                     
  678.                     SELECT CASE menop%
  679.  
  680.                       CASE 2  'generate basic program
  681.  
  682.                         LOCATE , , 0, 0
  683.                         dialog$(1) = "Have you SAVE'd your screen"
  684.                         dialog$(2) = "Do you still want to exit SCRGEN ?"
  685.                         Ques$ = "(Y/N)"
  686.                         yn$ = "YyNn"
  687.                         
  688.                         CALL AskQuestion(dialog$(), 2, 2, 1, BLACK, WHITE, BLACK, WHITE, Ques$, yn$)
  689.                         
  690.                         IF yn$ = "Y" THEN
  691.                           CHAIN "progen71"
  692.                         END IF
  693.  
  694.                       CASE 3  'generate screens
  695.  
  696.                         LOCATE , , 0, 0
  697.                         dialog$(1) = "Have you SAVE'd your screen"
  698.                         dialog$(2) = "Do you still want to exit SCRGEN ?"
  699.                         Ques$ = "(Y/N)"
  700.                         yn$ = "YyNn"
  701.                         
  702.                         CALL AskQuestion(dialog$(), 2, 2, 1, BLACK, WHITE, BLACK, WHITE, Ques$, yn$)
  703.                         
  704.                         IF yn$ = "Y" THEN  'generate screens
  705.                           CHAIN "prorpt71"
  706.                         END IF
  707.  
  708.                       CASE 4  'generate screens
  709.  
  710.                         LOCATE , , 0, 0
  711.                         dialog$(1) = "Have you SAVE'd your screen"
  712.                         dialog$(2) = "Do you still want to exit SCRGEN ?"
  713.                         Ques$ = "(Y/N)"
  714.                         yn$ = "YyNn"
  715.                         
  716.                         CALL AskQuestion(dialog$(), 2, 2, 1, BLACK, WHITE, BLACK, WHITE, Ques$, yn$)
  717.                         
  718.                         IF yn$ = "Y" THEN  'generate screens
  719.                           CLOSE
  720.                           END
  721.                         END IF
  722.                         
  723.                     END SELECT
  724.                 END SELECT
  725.                 
  726.               CASE 60  'F2 insert field info
  727.                 
  728.                 initindex
  729.                 
  730.                 DO
  731.                   LOCATE , , 0, 0
  732.                   RecFieldselect RecFieldNumIDX, key$, curmasrec, IndexRec, exitcode
  733.                   
  734.                   IF exitcode = 0 THEN
  735.                     nodata
  736.                     EXIT DO
  737.                   END IF
  738.                   
  739.                   IF exitcode = 1 THEN
  740.                     EXIT DO
  741.                   END IF
  742.                   
  743.                   WHILE exitcode = 2
  744.                     
  745.                     GET #datfile, curmasrec, RecField
  746.                     
  747.                     GetBackground 1, 1, 25, 79, fs$
  748.                     
  749.                     DispRecField RecField
  750.                     
  751.                     ixv = RecFieldNumIDX
  752.                     
  753.                     BO$ = "    Next    Prev    Search    Insert   Formats" + CHR$(255) + "information  Quit      "
  754.                     
  755.                     Imopt = MenuBar(25, 3, BO$, BLACK, WHITE, RED, 4)
  756.                     
  757.                     IF Imopt = 3 THEN
  758.                       exitcode = 0
  759.                     END IF
  760.                     
  761.                     IF Imopt = 4 THEN  'insert field
  762.                       
  763.                       PutBackground 1, 1, fs$
  764.                       fs$ = ""
  765.                       MID$(scrnline$(y%), x%, LEN(RTRIM$(RecField.format))) = STRING$(LEN(RTRIM$(RecField.format)), CHR$(219))
  766.                       fl$ = RecField.format
  767.                       Trim fl$
  768.                       
  769.                       FOR fp% = x% TO x% + LEN(fl$) - 1
  770.                         fieldpointer%(y%, fp%) = curmasrec
  771.                       NEXT
  772.                       
  773.                       RecField.erow = strval$(y%)
  774.                       RecField.ecol = strval$(x%)
  775.                       
  776.                       PUT #datfile, curmasrec, RecField
  777.                       
  778.                       pnc scrnline$(y%), y%, 1, fg%, bg%
  779.                       
  780.                       EXIT DO
  781.                     END IF
  782.                     
  783.                     IF Imopt = 5 THEN
  784.                       
  785.                       formatinfo
  786.                       proginfo1
  787.                       proginfo2
  788.                       mainscreen
  789.                       
  790.                     END IF
  791.                     
  792.                     IF Imopt = 6 THEN
  793.                       PutBackground 1, 1, fs$
  794.                       fs$ = ""
  795.                       
  796.                       EXIT DO
  797.                     END IF
  798.                     IF Imopt = 1 THEN
  799.                       PIM "N", ixv, nul$, curmasrec, IndexRec
  800.                     END IF
  801.                     
  802.                     IF Imopt = 2 THEN
  803.                       PIM "P", ixv, nul$, curmasrec, IndexRec
  804.                     END IF
  805.                   WEND
  806.                 LOOP
  807.                 
  808.               CASE 61  'F3 Display definition
  809.                 
  810.                 IF fieldset% THEN
  811.                   nav% = fieldpointer%(y%, x%)
  812.                   GetBackground 1, 1, 25, 79, fs$
  813.                   fp% = fieldpointer%(y%, x%)
  814.                   
  815.                   IF fp% THEN
  816.                     
  817.                     GET #datfile, fp%, RecField
  818.                     LOCATE , , 0, 0
  819.                     DispRecField RecField
  820.                     waitkey 24, fg%, bg%
  821.                   END IF
  822.                   
  823.                   PutBackground 1, 1, fs$
  824.                   fs$ = ""
  825.                 ELSE
  826.                   fid$ = "                 "
  827.                 END IF
  828.                 
  829.               CASE 62  'F4 delete field info from screen
  830.                 
  831.                 IF fieldset% THEN
  832.                   fp% = fieldpointer%(y%, x%)
  833.                   IF fp% THEN
  834.                     GET #datfile, fp%, RecField
  835.                     fid$ = RecField.name
  836.                   END IF
  837.                   
  838.                   MID$(scrnline$(y%), x%, LEN(RTRIM$(RecField.format))) = STRING$(LEN(RTRIM$(RecField.format)), CHR$(32))
  839.                   fl$ = RecField.format
  840.                   Trim fl$
  841.                   
  842.                   FOR fp% = x% TO x% + LEN(fl$) - 1
  843.                     fieldpointer%(y%, fp%) = 0
  844.                   NEXT
  845.                   
  846.                   RecField.erow = strval$(0)
  847.                   RecField.ecol = strval$(0)
  848.                   pnc scrnline$(y%), y%, 1, fg%, bg%
  849.                END IF
  850.  
  851.               CASE 63 'F5
  852.               CASE 64 'F6
  853.               CASE 65 'F7
  854.  
  855.               CASE 66 'F8 select alt char
  856.  
  857.                 FOR j% = 1 TO 70
  858.                   fl$(j%) = CHR$(j% + 173)
  859.                 NEXT j%
  860.                 LOCATE , , 0, 0
  861.  
  862.                 ch% = SelBox%(fl$(), 70, 8, 1, fg%, bg%, rev%)
  863.                 lsch% = ASC(fl$(ch%))
  864.                 ctype% = 1
  865.  
  866.               CASE 67 'F9 Repeat last Alternate Character
  867.  
  868.                 ch% = lsch%
  869.                 ctype% = 1
  870.               
  871.               CASE 82  ' Insert on / off
  872.                 
  873.                 IF ins$ = "Off" THEN
  874.                   ins$ = "On "
  875.                 ELSE
  876.                   ins$ = "Off"
  877.                 END IF
  878.                 
  879.               CASE 83  ' Delete
  880.  
  881.                 IF fieldpointer%(y%, x%) = 0 THEN
  882.                   
  883.                   IF x% = 1 THEN
  884.                     scrnline$(y%) = MID$(scrnline$(y%), 2, 80) + " "
  885.                   ELSEIF x% = 80 THEN
  886.                     MID$(scrnline$(y%), 80, 1) = " "
  887.                   ELSEIF (x% > 1 AND x% < 80) THEN
  888.                     pref$ = MID$(scrnline$(y%), 1, x% - 1)
  889.                     post$ = MID$(scrnline$(y%), x% + 1, 79)
  890.                     scrnline$(y%) = pref$ + post$ + " "
  891.                   END IF
  892.                   
  893.                   CALL pnc(scrnline$(y%), y%, 1, fg%, bg%)
  894.                   
  895.                   IF INSTR(scrnline$(y%), CHR$(219)) THEN
  896.                     
  897.                     fieldpointer%(y%, 80) = 0
  898.                     
  899.                     FOR k% = (x% - 1) TO 79
  900.                       SWAP fieldpointer%(y%, k%), fieldpointer%(y%, k% + 1)
  901.                     NEXT k%
  902.                     
  903.                     GOSUB updateREC
  904.                     
  905.                   END IF
  906.                 END IF
  907.             END SELECT
  908.             
  909.           CASE ELSE
  910.             
  911.         END SELECT
  912.         
  913.         IF editmode% = 0 OR (drawhorzlin% = 1 OR drawboxlin% = 1) THEN
  914.           IF ch% = 75 THEN  ' Left Arrow
  915.             x% = x% - 1
  916.           END IF
  917.           
  918.           IF ch% = 77 THEN  ' Right Arrow
  919.             x% = x% + 1
  920.           END IF
  921.         END IF
  922.         
  923.         IF editmode% = 0 OR (drawvertlin% = 1 OR drawboxlin% = 1) THEN
  924.           IF ch% = 72 THEN  ' Up Arrow
  925.             y% = y% - 1
  926.           END IF
  927.           
  928.           IF ch% = 80 THEN  ' Down Arrow
  929.             y% = y% + 1
  930.           END IF
  931.         END IF
  932.         
  933.         IF ctype% = 1 THEN
  934.           
  935.           IF ch% = 13 THEN
  936.             IF editmode% = 0 THEN
  937.               x% = 1
  938.               y% = y% + 1
  939.             END IF
  940.             IF crx% > x% THEN
  941.               stx% = x%
  942.               enx% = crx%
  943.             ELSE
  944.               stx% = crx%
  945.               enx% = x%
  946.             END IF
  947.             IF cry% > y% THEN
  948.               sty% = y%
  949.               eny% = cry%
  950.             ELSE
  951.               sty% = cry%
  952.               eny% = y%
  953.             END IF
  954.             IF editmode% = 1 THEN
  955.               IF drawhorzlin% = 1 THEN  ' Complete horizontal line
  956.                 
  957.                 fl$(1) = STRING$(5, 196)
  958.                 fl$(2) = STRING$(5, 205)
  959.                 fl$(3) = STRING$(5, "-")
  960.                 fl$(4) = STRING$(5, "_")
  961.                 fl$(5) = STRING$(5, "=")
  962.                 fl$(6) = STRING$(5, " ")
  963.                 
  964.                 LOCATE , , 0, 0
  965.                 
  966.                 SB% = SelBox(fl$(), 6, 5, 5, BLACK, WHITE, RED)
  967.                 OPT$ = fl$(SB%)
  968.                 IF LEN(OPT$) <> 0 THEN
  969.                   FOR drawhorzlin% = stx% TO enx%
  970.                     MID$(scrnline$(y%), drawhorzlin%, 1) = CHR$(ASC(OPT$))
  971.                   NEXT drawhorzlin%
  972.                   CALL pnc(scrnline$(y%), y%, 1, fg%, bg%)
  973.                 END IF
  974.                 drawhorzlin% = 0
  975.               END IF
  976.               
  977.               IF drawvertlin% = 1 THEN  ' Complete vertical line
  978.                 
  979.                 fl$(1) = CHR$(179)
  980.                 fl$(2) = CHR$(186)
  981.                 fl$(3) = "|"
  982.                 fl$(4) = " "
  983.                 
  984.                 LOCATE , , 0, 0
  985.                 
  986.                 SB% = SelBox(fl$(), 4, 4, 2, BLACK, WHITE, RED)
  987.                 OPT$ = fl$(SB%)
  988.                 
  989.                 IF LEN(OPT$) <> 0 THEN
  990.                   FOR drawvertlin% = sty% TO eny%
  991.                     MID$(scrnline$(drawvertlin%), x%, 1) = CHR$(ASC(OPT$))
  992.                     CALL pnc(scrnline$(drawvertlin%), drawvertlin%, 1, fg%, bg%)
  993.                   NEXT drawvertlin%
  994.                 END IF
  995.                 drawvertlin% = 0
  996.               END IF
  997.               
  998.               IF drawboxlin% = 1 THEN  ' Complete box
  999.                 fl$(1) = CHR$(218) + CHR$(196) + CHR$(191)
  1000.                 fl$(2) = CHR$(213) + CHR$(205) + CHR$(184)
  1001.                 fl$(3) = CHR$(214) + CHR$(196) + CHR$(183)
  1002.                 fl$(4) = CHR$(201) + CHR$(205) + CHR$(187)
  1003.                 fl$(5) = CHR$(32) + CHR$(32) + CHR$(32)
  1004.                 
  1005.                 LOCATE , , 0, 0
  1006.                 
  1007.                 SB% = SelBox(fl$(), 5, 4, 3, BLACK, WHITE, RED)
  1008.                 OPT$ = fl$(SB%)
  1009.                 
  1010.                 IF LEN(OPT$) <> 0 THEN
  1011.                   box.t% = ASC(OPT$)
  1012.                   SELECT CASE ASC(OPT$)
  1013.                     CASE 32
  1014.                       tl% = 32: tr% = 32: bl% = 32: br% = 32: vt% = 32: hz% = 32
  1015.                     CASE 218
  1016.                       tl% = 218: tr% = 191: bl% = 192: br% = 217: vt% = 179: hz% = 196
  1017.                     CASE 213
  1018.                       tl% = 213:  tr% = 184: bl% = 212: br% = 190: vt% = 179: hz% = 205
  1019.                     CASE 201
  1020.                       tl% = 201: tr% = 187: bl% = 200: br% = 188: vt% = 186: hz% = 205
  1021.                     CASE 214
  1022.                       tl% = 214: tr% = 183: bl% = 211: br% = 189: vt% = 186: hz% = 196
  1023.                     CASE ELSE
  1024.                   END SELECT
  1025.                   
  1026.                   FOR bx% = stx% + 1 TO enx% - 1
  1027.                     MID$(scrnline$(sty%), bx%, 1) = CHR$(hz%)
  1028.                     MID$(scrnline$(eny%), bx%, 1) = CHR$(hz%)
  1029.                   NEXT bx%
  1030.                   
  1031.                   FOR bx% = sty% + 1 TO eny% - 1
  1032.                     MID$(scrnline$(bx%), stx%, 1) = CHR$(vt%)
  1033.                     MID$(scrnline$(bx%), enx%, 1) = CHR$(vt%)
  1034.                   NEXT bx%
  1035.                   
  1036.                   MID$(scrnline$(sty%), stx%, 1) = CHR$(tl%)
  1037.                   MID$(scrnline$(eny%), stx%, 1) = CHR$(bl%)
  1038.                   MID$(scrnline$(sty%), enx%, 1) = CHR$(tr%)
  1039.                   MID$(scrnline$(eny%), enx%, 1) = CHR$(br%)
  1040.                   
  1041.                   FOR bx% = sty% TO eny%
  1042.                     CALL pnc(scrnline$(bx%), bx%, 1, fg%, bg%)
  1043.                   NEXT bx%
  1044.                 END IF
  1045.                 drawboxlin% = 0
  1046.               END IF
  1047.               editmode% = 0
  1048.             END IF
  1049.           END IF
  1050.           
  1051.           IF editmode% = 0 THEN
  1052.             IF ch% = 8 THEN
  1053.               MID$(scrnline$(y%), x%, 1) = CHR$(32)
  1054.               CALL pnc(scrnline$(y%), y%, 1, fg%, bg%)
  1055.               x% = x% - 1
  1056.             END IF
  1057.             
  1058.             IF ch% = 127 THEN
  1059.               IF x% = 1 THEN
  1060.                 scrnline$(y%) = MID$(scrnline$(y%), 2, 80) + " "
  1061.               END IF
  1062.               IF x% = 80 THEN
  1063.                 MID$(scrnline$(y%), 80, 1) = " "
  1064.               END IF
  1065.               
  1066.               IF (x% > 1 AND x% < 80) THEN
  1067.                 pref$ = MID$(scrnline$(y%), 1, x% - 1)
  1068.                 post$ = MID$(scrnline$(y%), x% + 1, 79)
  1069.                 scrnline$(y%) = pref$ + post$ + " "
  1070.               END IF
  1071.               
  1072.               CALL pnc(scrnline$(y%), y%, 1, fg%, bg%)
  1073.             END IF
  1074.             
  1075.             IF ch% = 9 THEN
  1076.               x% = x% + 8
  1077.             END IF
  1078.             
  1079.             IF (ch% > 31 AND ch% < 127) OR (ch% > 173 AND ch% < 254) THEN
  1080.               IF fieldpointer%(y%, x%) = 0 THEN
  1081.                 
  1082.                 IF ins$ = "Off" THEN
  1083.                   MID$(scrnline$(y%), x%, 1) = CHR$(ch%)
  1084.                   
  1085.                 ELSE  ' ins$ = "On "
  1086.                   
  1087.                   IF x% = 1 THEN
  1088.                     scrnline$(y%) = CHR$(ch%) + MID$(scrnline$(y%), 1, 79)
  1089.                   END IF
  1090.                   
  1091.                   IF x% = 80 THEN
  1092.                     MID$(scrnline$(y%), 80, 1) = CHR$(ch%)
  1093.                   END IF
  1094.                   
  1095.                   IF (x% > 1 AND x% < 80) THEN
  1096.                     pref$ = MID$(scrnline$(y%), 1, x% - 1)
  1097.                     post$ = MID$(scrnline$(y%), x%, 79)
  1098.                     scrnline$(y%) = pref$ + CHR$(ch%) + post$
  1099.                   END IF
  1100.                   
  1101.                   IF LEN(scrnline$(y%)) > 80 THEN
  1102.                     scrnline$(y%) = MID$(scrnline$(y%), 1, 80)
  1103.                   END IF
  1104.                   IF INSTR(scrnline$(y%), CHR$(219)) THEN
  1105.                     xs% = x% - 1
  1106.                     FOR k% = 79 TO xs% STEP -1
  1107.                       SWAP fieldpointer%(y%, k%), fieldpointer%(y%, k% + 1)
  1108.                     NEXT k%
  1109.                     GOSUB updateREC
  1110.                   END IF
  1111.                 END IF
  1112.                 
  1113.                 CALL pnc(scrnline$(y%), y%, 1, fg%, bg%)
  1114.                 
  1115.                 x% = x% + 1
  1116.                 
  1117.               END IF
  1118.             END IF
  1119.           END IF
  1120.         END IF
  1121.         
  1122.         IF y% > ymax% THEN
  1123.           y% = ymin%
  1124.         ELSEIF y% < ymin% THEN
  1125.           y% = ymax%
  1126.         ELSEIF x% > xmax% THEN
  1127.           x% = xmin%
  1128.         ELSEIF x% < xmin% THEN
  1129.           x% = xmax%
  1130.         END IF
  1131.         
  1132.       WEND
  1133.       
  1134.       EXIT SUB
  1135.       
  1136. updateREC:
  1137.       prevfp% = 0
  1138.       FOR i% = 1 TO 25
  1139.         prevfp% = 0
  1140.         
  1141.         IF INSTR(scrnline$(i%), CHR$(219)) THEN
  1142.           
  1143.           FOR k% = 1 TO 80
  1144.             
  1145.             fp% = fieldpointer%(i%, k%)
  1146.             IF fp% THEN
  1147.               IF fp% <> prevfp% THEN
  1148.                 GET #datfile, fp%, RecField
  1149.                 RecField.erow = strval$(i%)
  1150.                 RecField.ecol = strval$(k%)
  1151.                 PUT #datfile, fp%, RecField
  1152.               END IF
  1153.             END IF
  1154.             
  1155.             prevfp% = fieldpointer%(i%, k%)
  1156.             
  1157.           NEXT k%
  1158.         END IF
  1159.       NEXT i%
  1160.       initindex
  1161.       RETURN
  1162.       
  1163.     END SUB
  1164.  
  1165.     SUB clearscreen
  1166.       FOR j% = 1 TO 25
  1167.         scrnline$(j%) = STRING$(80, 32)
  1168.         FOR k% = 1 TO 80
  1169.           fieldpointer%(j%, k%) = 0
  1170.         NEXT k%
  1171.       NEXT j%
  1172.       
  1173.     END SUB
  1174.  
  1175.     SUB createdatafile
  1176.       
  1177. redofile:
  1178.       
  1179.       DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  1180.       CenterText "Enter Name For New Database", 22, BLACK, WHITE
  1181.       
  1182.       MsgOpt$(1) = "Enter new file specification"
  1183.       ans$ = ""
  1184.       
  1185.       DialogBox MsgOpt$(), 1, 1, 8, BLACK, WHITE, BLACK, WHITE, 1, ans$, "", Ek
  1186.       IF Ek = 7 THEN
  1187.         EXIT SUB
  1188.       END IF
  1189.       filespec$ = ans$
  1190.       
  1191.       delimit = INSTR(filespec$, ".")
  1192.       
  1193.       IF delimit THEN
  1194.         FileName$ = LEFT$(filespec$, delimit - 1)
  1195.         fileext$ = RIGHT$(filespec$, LEN(filespec$) - (delimit))
  1196.       ELSE
  1197.         FileName$ = filespec$
  1198.         fileext$ = "FLD"
  1199.       END IF
  1200.       
  1201.       IF LEN(filespec$) = 0 OR LEN(FileName$) > 8 OR LEN(fileext$) > 3 THEN
  1202.         MsgOpt$(1) = "You didn't enter a valid file specification."
  1203.         MsgOpt$(2) = ""
  1204.         MsgOpt$(3) = "Press any key to continue"
  1205.         Message MsgOpt$(), 3, 3, BLACK, WHITE + 8, BLACK, WHITE
  1206.         GOTO redofile
  1207.       END IF
  1208.       Trim FileName$
  1209.       MASTERFILE$ = FileName$ + "." + fileext$
  1210.       
  1211.     END SUB
  1212.  
  1213.     SUB DispRecField (temp AS RecordType)
  1214.       
  1215.       'Display details on screen
  1216.       
  1217.       fg = BLACK
  1218.       bg = WHITE
  1219.       
  1220.       TopRow = 7
  1221.       LeftCol = 5
  1222.       botrow = 20
  1223.       rightcol = 74
  1224.       FrameType = 2
  1225.       
  1226.       'draw frame
  1227.       
  1228.       CALL drawwind(TopRow, LeftCol, botrow, rightcol, FrameType, 1)
  1229.       'color frame
  1230.       CALL Colorwind(TopRow, LeftCol, botrow, rightcol, 0, 1, fg, bg)
  1231.       
  1232.       pnc "Field Name  :                                ", 9, 8, fg, bg
  1233.       pnc "Key (Y/N)   :                                ", 10, 8, fg, bg
  1234.       pnc "Field Format:                                ", 11, 8, fg, bg
  1235.       pnc "Field Length:                                ", 12, 8, fg, bg
  1236.       pnc "Type        :                                ", 13, 8, fg, bg
  1237.       pnc "Case (U/L/A):                                ", 14, 8, fg, bg
  1238.       pnc "Number Dec  :                                ", 15, 8, fg, bg
  1239.       pnc "Row Pos     :                                ", 16, 8, fg, bg
  1240.       pnc "Col Pos     :                                ", 17, 8, fg, bg
  1241.       pnc "Comment     :                                ", 18, 8, fg, bg
  1242.       pnc "Program name:                                ", 19, 8, fg, bg
  1243.       
  1244.       pnc temp.name, 9, 21, fg, bg
  1245.       pnc temp.key, 10, 21, fg, bg
  1246.       pnc temp.format, 11, 21, fg, bg
  1247.       pnc temp.length, 12, 21, fg, bg
  1248.       pnc temp.type, 13, 21, fg, bg
  1249.       pnc temp.case, 14, 21, fg, bg
  1250.       pnc temp.decimal, 15, 21, fg, bg
  1251.       pnc temp.erow, 16, 21, fg, bg
  1252.       pnc temp.ecol, 17, 21, fg, bg
  1253.       pnc temp.comment, 18, 21, fg, bg
  1254.       pnc temp.progname, 19, 21, fg, bg
  1255.       
  1256.     END SUB
  1257.  
  1258.     SUB initindex STATIC
  1259.  
  1260.       DIM TempField AS RecordType
  1261.       
  1262.       FOR j% = 0 TO 24
  1263.         FOR k% = 0 TO 80
  1264.           fieldpointer%(j%, k%) = 0
  1265.         NEXT k%
  1266.       NEXT j%
  1267.       
  1268.       LastREC = LOF(datfile) \ LEN(TempField)
  1269.       
  1270.       numberoffields = 0
  1271.       FOR record = 1 TO LastREC
  1272.         
  1273.         ' Read a record from the file and put each field in the array.
  1274.         
  1275.         GET #datfile, record, TempField
  1276.         
  1277.         IF TempField.status = "U" THEN
  1278.           
  1279.           Findex(record).status = TempField.status
  1280.           Findex(record).Num = TempField.Num
  1281.           Findex(record).name = TempField.name
  1282.           Findex(record).type = TempField.type
  1283.           Findex(record).case = TempField.case
  1284.           Findex(record).key = TempField.key
  1285.           Findex(record).decimal = TempField.decimal
  1286.           Findex(record).length = TempField.length
  1287.           Findex(record).format = TempField.format
  1288.           Findex(record).erow = TempField.erow
  1289.           Findex(record).ecol = TempField.ecol
  1290.           Findex(record).comment = TempField.comment
  1291.           Findex(record).progname = TempField.progname
  1292.           Findex(record).recnum = record
  1293.           
  1294.           fl$ = TempField.format
  1295.           Trim fl$
  1296.           FOR fieldREC% = VAL(TempField.ecol) TO VAL(TempField.ecol) + LEN(fl$) - 1
  1297.             fieldpointer%(VAL(TempField.erow), fieldREC%) = record
  1298.           NEXT
  1299.           
  1300.           numberoffields = numberoffields + 1
  1301.         END IF
  1302.       NEXT record
  1303.     END SUB
  1304.  
  1305.     '
  1306.     SUB RecFieldselect (indexnum, key$, MastRec, IndexRec, exitcode) STATIC
  1307.       
  1308.       fg = WHITE
  1309.       bg = BLUE
  1310.       
  1311.       REDIM dg$(5)
  1312.       REDIM TempMasREC(10)
  1313.       REDIM TempIdxREC(10)
  1314.       
  1315.       CONST CORRUPT = "Error: PIM Index Corrupt"
  1316.       CONST EX$ = " ESC = Exit  ENTER = Select  ? = Key search "  '  F1 = Options "
  1317.       
  1318.       'define select option window
  1319.       
  1320.       row = 6
  1321.       col = 3
  1322.       lin = 10
  1323.       numofsel = 0
  1324.       
  1325.       exitcode = 0  'What's selected
  1326.       bodertype = 2  'Border typeincode
  1327.       
  1328.       Nf = BLACK  'Normal Foreground
  1329.       Nb = WHITE  'Normal Background
  1330.       sf = WHITE + 8  'Select Foreground
  1331.       SB = BLACK  'Select Background
  1332.       ff = YELLOW  'Frame Foreground
  1333.       Fb = BLACK  'Frame Background
  1334.       
  1335.       'end of select option's
  1336.       
  1337.       MsgLine EX$, 25, 0, 7
  1338.       
  1339. restart:
  1340.       
  1341.       IF PIMstats(indexnum) = 0 THEN  'No keys in the index
  1342.         curmasrec = 0
  1343.         IndexRec = 0
  1344.         exitcode = 0  'code No keys in the Index
  1345.         EXIT SUB
  1346.       END IF
  1347.       
  1348.       KeyLen = 20
  1349.       skey$ = "FIELD NAME"
  1350.       dg$(1) = "Enter FIELD NAME"
  1351.       dg$(2) = "An exact match is not needed."
  1352.       
  1353.       height = lin
  1354.       startpos = height
  1355.       col = 80 / 2 - KeyLen / 2
  1356.       dwidth = KeyLen  'Maximum(KeyLen, LEN(Ex$))
  1357.       
  1358.       Trim dg$(1)
  1359.       Trim dg$(2)
  1360.       
  1361.       Dwidth2 = dwidth
  1362.       dwidth = dwidth + 4
  1363.       
  1364.       totalheight = height + 2  'Scroll box height (plus borders)
  1365.       totalheight = totalheight + 2  'Quit Box + ESC + lineNum
  1366.       checkheight = totalheight + row - 1  'Check the complete height
  1367.       
  1368.       IF checkheight > MAXROW THEN
  1369.         curmasrec = 0
  1370.         IndexRec = 0
  1371.         EXIT SUB
  1372.       END IF
  1373.       
  1374.       CheckWidth = dwidth + col - 1
  1375.       
  1376.       IF CheckWidth > 80 THEN
  1377.         curmasrec = 0
  1378.         IndexRec = 0
  1379.         EXIT SUB
  1380.       END IF
  1381.       'Save Screen
  1382.       
  1383.       GetBackground row, col, row + totalheight + 2, col + dwidth + 1, buf$
  1384.       DrawBox row, col, dwidth, totalheight, bodertype, ff, Fb, 1, Nf, Nb, 0
  1385.       
  1386.       Crow = row + height + 1
  1387.       Ccol = col + 2
  1388.       Acc$ = STRING$(dwidth - 2, 196)
  1389.       
  1390.       pnc Acc$, Crow, Ccol - 1, ff, Fb
  1391.       
  1392.       Crow = row + height + 2
  1393.       kcol = Ccol + KeyLen / 2 - LEN(skey$) / 2
  1394.       
  1395.       pnc skey$, Crow, kcol, ff, Fb
  1396.       
  1397.       GOSUB homeCkeys  'Display from the top
  1398.       GOSUB DisplayCkeys  'Display the Ckeys
  1399.       CurrentROW = 1  'Current Row
  1400.       
  1401.       DO  'Loop
  1402.         Acc$ = DispLine$(CurrentROW)
  1403.         
  1404.         IF LEN(Acc$) < Dwidth2 - 2 THEN
  1405.           Acc$ = Acc$ + STRING$(Dwidth2 - LEN(Acc$), 32)
  1406.         END IF
  1407.         
  1408.         Crow = CurrentROW + row
  1409.         pnc Acc$, Crow, Ccol, sf, SB
  1410.         
  1411.         kbd$ = ""
  1412.         
  1413.         WHILE kbd$ = ""
  1414.           kbd$ = INKEY$
  1415.         WEND
  1416.         
  1417.         IF LEN(kbd$) = 1 THEN
  1418.           useroption = ASC(RIGHT$(kbd$, 1))
  1419.           
  1420.           SELECT CASE useroption
  1421.               
  1422.             CASE 63  '? search key
  1423.               
  1424.               DialogBox dg$(), 1, 1, 20, ff, Fb, Nf, Nb, 1, ans$, "", Exk
  1425.               
  1426.               key$ = ans$
  1427.               'IndexFind
  1428.               PIM "S", indexnum, key$, MastRec, IndexRec
  1429.               
  1430.               IF IndexRec THEN
  1431.                 GOSUB getrecinfo
  1432.                 DispLine$(1) = DispLine$
  1433.                 TempMasREC(1) = ABS(MastRec)
  1434.                 TempIdxREC(1) = IndexRec
  1435.                 
  1436.               ELSE
  1437.                 PRINT CORRUPT
  1438.                 END
  1439.               END IF
  1440.               
  1441.               PrevMastRec = MastRec
  1442.               PrevIndexRec = IndexRec
  1443.               
  1444.               GOSUB GetNextCten
  1445.               CurrentROW = 1
  1446.               GOSUB DisplayCkeys
  1447.               
  1448.             CASE 48 TO 57, 65 TO 90, 97 TO 122  'first letter search
  1449.               'IndexFind
  1450.               key$ = UCASE$(CHR$(useroption))
  1451.               
  1452.               PIM "S", indexnum, key$, MastRec, IndexRec
  1453.               
  1454.               IF IndexRec THEN
  1455.                 GOSUB getrecinfo
  1456.                 DispLine$(1) = DispLine$
  1457.                 TempMasREC(1) = ABS(MastRec)
  1458.                 TempIdxREC(1) = IndexRec
  1459.                 
  1460.               ELSE
  1461.                 PRINT CORRUPT
  1462.                 END
  1463.               END IF
  1464.               
  1465.               PrevMastRec = MastRec
  1466.               PrevIndexRec = IndexRec
  1467.               
  1468.               GOSUB GetNextCten
  1469.               CurrentROW = 1
  1470.               GOSUB DisplayCkeys
  1471.               
  1472.             CASE 27  'ESCAPE
  1473.               key$ = ""
  1474.               MastRec = 0
  1475.               IndexRec = 0
  1476.               exitcode = 1  ' ESC
  1477.               EXIT DO
  1478.               
  1479.             CASE 13  'RETURN
  1480.               key$ = DispLine$(CurrentROW)
  1481.               MastRec = TempMasREC(CurrentROW)
  1482.               IndexRec = TempIdxREC(CurrentROW)
  1483.               exitcode = 2  ' RETURN
  1484.               EXIT DO
  1485.               
  1486.             CASE ELSE
  1487.           END SELECT
  1488.           
  1489.         END IF
  1490.         
  1491.         IF LEN(kbd$) = 2 THEN
  1492.           useroption = ASC(RIGHT$(kbd$, 1))
  1493.           
  1494.           SELECT CASE useroption
  1495.               
  1496.             CASE 59
  1497.               
  1498.               Fkey = useroption - 58
  1499.               IF numofsel >= Fkey THEN
  1500.                 exitcode = Fkey
  1501.                 key$ = DispLine$(CurrentROW)
  1502.                 MastRec = TempMasREC(CurrentROW)
  1503.                 IndexRec = TempIdxREC(CurrentROW)
  1504.                 
  1505.                 menu$ = "1 - Search by NAME\"
  1506.                 menu$ = menu$ + "2 - Search by length\"
  1507.                 
  1508.                 indexnum = MenuWindow(0, 0, menu$, "Search option", BLACK, WHITE, RED, 0)
  1509.                 
  1510.                 PutBackground row, col, buf$
  1511.                 buf$ = ""
  1512.                 MsgLine EX$, 25, 0, 7
  1513.                 
  1514.                 GOTO restart
  1515.               END IF
  1516.               
  1517.             CASE 71  'Home
  1518.               CurrentROW = 1
  1519.               GOSUB homeCkeys
  1520.               GOSUB DisplayCkeys
  1521.               
  1522.             CASE 81  'pg Down
  1523.               CurrentROW = 1
  1524.               FOR lineNum = 1 TO height
  1525.                 TempMasREC(lineNum) = 0
  1526.                 TempIdxREC(lineNum) = 0
  1527.                 PrevMastRec = 0
  1528.                 DispLine$(lineNum) = STRING$(KeyLen, 32)
  1529.               NEXT lineNum
  1530.               
  1531.               PIM "N", indexnum, key$, MastRec, IndexRec
  1532.               
  1533.               IF IndexRec THEN
  1534.                 GOSUB getrecinfo
  1535.                 DispLine$(1) = DispLine$
  1536.                 TempMasREC(1) = MastRec
  1537.                 TempIdxREC(1) = IndexRec
  1538.                 
  1539.               ELSE
  1540.                 PRINT CORRUPT
  1541.                 END
  1542.               END IF
  1543.               
  1544.               PrevMastRec = MastRec
  1545.               PrevIndexRec = IndexRec
  1546.               
  1547.               GOSUB GetNextCten
  1548.               GOSUB DisplayCkeys
  1549.               
  1550.             CASE 73  'pg Up
  1551.               CurrentROW = 1
  1552.               GOSUB GetLastCpage
  1553.               GOSUB DisplayCkeys
  1554.               
  1555.             CASE 79  'End
  1556.               IF startpos >= height THEN
  1557.                 CurrentROW = 1
  1558.                 GOSUB endCkeys
  1559.                 GOSUB DisplayCkeys
  1560.               END IF
  1561.             CASE 80  'Down Arrow
  1562.               CurrentROW = CurrentROW + 1
  1563.               IF CurrentROW > height THEN
  1564.                 CurrentROW = CurrentROW - 1
  1565.                 
  1566.                 IF TempIdxREC(height) <> 0 THEN
  1567.                   key$ = DispLine$(height)
  1568.                   MastRec = TempMasREC(height)
  1569.                   IndexRec = TempIdxREC(height)
  1570.                   PrevIndexRec = IndexRec
  1571.                   'IndexNext
  1572.                   PIM "N", indexnum, key$, MastRec, IndexRec
  1573.                   
  1574.                   IF IndexRec <> 0 THEN
  1575.                     IF PrevIndexRec <> IndexRec THEN
  1576.                       FOR lineNum = 1 TO height - 1
  1577.                         TempIdxREC(lineNum) = TempIdxREC(lineNum + 1)
  1578.                         TempMasREC(lineNum) = TempMasREC(lineNum + 1)
  1579.                         DispLine$(lineNum) = DispLine$(lineNum + 1)
  1580.                       NEXT lineNum
  1581.                       GOSUB getrecinfo
  1582.                       DispLine$(height) = DispLine$
  1583.                       TempMasREC(height) = MastRec
  1584.                       TempIdxREC(height) = IndexRec
  1585.                     END IF
  1586.                   END IF
  1587.                 END IF
  1588.               ELSE
  1589.                 IF TempIdxREC(CurrentROW) = 0 THEN
  1590.                   CurrentROW = CurrentROW - 1
  1591.                 END IF
  1592.               END IF
  1593.               GOSUB DisplayCkeys
  1594.               
  1595.             CASE 72  'Up Arrow
  1596.               CurrentROW = CurrentROW - 1
  1597.               IF CurrentROW < 1 THEN
  1598.                 CurrentROW = CurrentROW + 1
  1599.                 
  1600.                 IF TempIdxREC(1) <> 0 THEN
  1601.                   key$ = DispLine$(1)
  1602.                   MastRec = TempMasREC(1)
  1603.                   IndexRec = TempIdxREC(1)
  1604.                   PrevIndexRec = IndexRec
  1605.                   'IndexPrevious
  1606.                   PIM "P", indexnum, key$, MastRec, IndexRec
  1607.                   
  1608.                   IF IndexRec <> 0 THEN
  1609.                     IF PrevIndexRec <> IndexRec THEN
  1610.                       FOR lineNum = height TO 2 STEP -1
  1611.                         TempIdxREC(lineNum) = TempIdxREC(lineNum - 1)
  1612.                         TempMasREC(lineNum) = TempMasREC(lineNum - 1)
  1613.                         DispLine$(lineNum) = DispLine$(lineNum - 1)
  1614.                       NEXT lineNum
  1615.                       GOSUB getrecinfo
  1616.                       DispLine$(1) = DispLine$
  1617.                       TempMasREC(1) = MastRec
  1618.                       TempIdxREC(1) = IndexRec
  1619.                     END IF
  1620.                   END IF
  1621.                 END IF
  1622.               ELSE
  1623.                 IF TempIdxREC(CurrentROW) = 0 THEN
  1624.                   CurrentROW = CurrentROW + 1
  1625.                 END IF
  1626.               END IF
  1627.               GOSUB DisplayCkeys
  1628.               
  1629.             CASE ELSE
  1630.           END SELECT
  1631.         END IF
  1632.       LOOP
  1633.       
  1634.       'Restore Screen
  1635.       
  1636.       PutBackground row, col, buf$
  1637.       buf$ = ""
  1638.       EXIT SUB
  1639.       
  1640. DisplayCkeys:
  1641.       
  1642.       FOR lineNum = 1 TO height
  1643.         Acc$ = DispLine$(lineNum)
  1644.         IF LEN(Acc$) < Dwidth2 THEN
  1645.           Acc$ = Acc$ + STRING$(Dwidth2 - LEN(Acc$), 32)
  1646.         END IF
  1647.         Crow = row + lineNum
  1648.         pnc Acc$, Crow, Ccol, Nf, Nb
  1649.       NEXT lineNum
  1650.       startpos = lineNum
  1651.       RETURN
  1652.       
  1653. homeCkeys:
  1654.       
  1655.       FOR lineNum = 1 TO height
  1656.         TempMasREC(lineNum) = 0
  1657.         TempIdxREC(lineNum) = 0
  1658.         PrevMastRec = 0
  1659.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1660.       NEXT lineNum
  1661.       
  1662.       PIM "F", indexnum, key$, MastRec, IndexRec
  1663.       
  1664.       IF IndexRec THEN
  1665.         
  1666.         GOSUB getrecinfo
  1667.         DispLine$(1) = DispLine$
  1668.         TempMasREC(1) = MastRec
  1669.         TempIdxREC(1) = IndexRec
  1670.         
  1671.       ELSE
  1672.         PRINT CORRUPT
  1673.         END
  1674.       END IF
  1675.       
  1676.       PrevMastRec = MastRec
  1677.       PrevIndexRec = IndexRec
  1678.       
  1679.       CurrentROW = 1
  1680.       
  1681. GetNextCten:
  1682.       
  1683.       FOR lineNum = 2 TO height
  1684.         TempMasREC(lineNum) = 0
  1685.         TempIdxREC(lineNum) = 0
  1686.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1687.       NEXT lineNum
  1688.       
  1689.       FOR lineNum = 2 TO height
  1690.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1691.         TempMasREC(lineNum) = 0
  1692.         TempIdxREC(lineNum) = 0
  1693.         
  1694.         PIM "N", indexnum, key$, MastRec, IndexRec
  1695.         
  1696.         IF IndexRec > 0 THEN
  1697.           IF PrevMastRec = MastRec AND IndexRec = PrevIndexRec THEN
  1698.             EXIT FOR
  1699.           ELSE
  1700.             GOSUB getrecinfo
  1701.             DispLine$(lineNum) = DispLine$
  1702.             TempMasREC(lineNum) = MastRec
  1703.             TempIdxREC(lineNum) = IndexRec
  1704.             PrevMastRec = MastRec
  1705.             PrevIndexRec = IndexRec
  1706.             
  1707.           END IF
  1708.         ELSE
  1709.           EXIT FOR
  1710.         END IF
  1711.       NEXT lineNum
  1712.       
  1713.       RETURN
  1714.       
  1715. endCkeys:
  1716.       dsppos = 1
  1717.       FOR lineNum = 1 TO height
  1718.         TempMasREC(lineNum) = 0
  1719.         TempIdxREC(lineNum) = 0
  1720.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1721.       NEXT lineNum
  1722.       
  1723.       PIM "L", indexnum, key$, MastRec, IndexRec
  1724.       
  1725.       IF IndexRec THEN
  1726.         
  1727.         GOSUB getrecinfo
  1728.         DispLine$(height) = DispLine$
  1729.         TempMasREC(height) = MastRec
  1730.         TempIdxREC(height) = IndexRec
  1731.       ELSE
  1732.         PRINT CORRUPT
  1733.         END
  1734.       END IF
  1735.       
  1736.       PrevMastRec = MastRec
  1737.       PrevIndexRec = IndexRec
  1738.       CurrentROW = 1
  1739.       
  1740. GetPreviousCten:
  1741.       
  1742.       FOR lineNum = 1 TO height - 1
  1743.         TempMasREC(lineNum) = 0
  1744.         TempIdxREC(lineNum) = 0
  1745.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1746.       NEXT lineNum
  1747.       startpos = 1
  1748.       FOR lineNum = height - 1 TO 1 STEP -1
  1749.         
  1750.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1751.         
  1752.         PIM "P", indexnum, key$, MastRec, IndexRec
  1753.         
  1754.         IF IndexRec > 0 THEN
  1755.           IF PrevIndexRec = IndexRec AND PrevMastRec = MastRec THEN
  1756.             
  1757.             EXIT FOR
  1758.           ELSE
  1759.             startpos = startpos + 1
  1760.             GOSUB getrecinfo
  1761.             DispLine$(lineNum) = DispLine$
  1762.             TempMasREC(lineNum) = MastRec
  1763.             TempIdxREC(lineNum) = IndexRec
  1764.             PrevMastRec = MastRec
  1765.             PrevIndexRec = IndexRec
  1766.             startrpos = startpos + 1
  1767.             
  1768.           END IF
  1769.         ELSE
  1770.           
  1771.           EXIT FOR
  1772.         END IF
  1773.       NEXT lineNum
  1774.       
  1775.       RETURN
  1776.       
  1777. GetnextCpage:
  1778.       
  1779.       key$ = DispLine$(height)
  1780.       MastRec = TempMasREC(height)
  1781.       
  1782.       FOR lineNum = 1 TO 2
  1783.         TempMasREC(lineNum) = 0
  1784.         TempIdxREC(lineNum) = 0
  1785.         PrevMastRec = 0
  1786.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1787.       NEXT lineNum
  1788.       
  1789.       PIM "N", indexnum, key$, MastRec, IndexRec
  1790.       
  1791.       IF IndexRec THEN
  1792.         GOSUB getrecinfo
  1793.         DispLine$(1) = DispLine$
  1794.         TempMasREC(1) = MastRec
  1795.         TempIdxREC(1) = IndexRec
  1796.       ELSE
  1797.         GOTO endCkeys
  1798.         RETURN
  1799.       END IF
  1800.       
  1801.       PrevMastRec = MastRec
  1802.       PrevIndexRec = IndexRec
  1803.       CurrentROW = 1
  1804.       
  1805. GetNextCpg:
  1806.       
  1807.       FOR lineNum = 2 TO height
  1808.         TempMasREC(lineNum) = 0
  1809.         TempIdxREC(lineNum) = 0
  1810.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1811.       NEXT lineNum
  1812.       
  1813.       FOR lineNum = 2 TO height
  1814.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1815.         TempMasREC(lineNum) = 0
  1816.         TempIdxREC(lineNum) = 0
  1817.         
  1818.         'get Next record
  1819.         PIM "N", indexnum, key$, MastRec, IndexRec
  1820.         IF IndexRec > 0 THEN
  1821.           IF PrevMastRec = MastRec AND IndexRec = PrevIndexRec THEN
  1822.             GOTO endCkeys
  1823.             
  1824.           ELSE
  1825.             GOSUB getrecinfo
  1826.             DispLine$(lineNum) = DispLine$
  1827.             TempMasREC(lineNum) = MastRec
  1828.             TempIdxREC(lineNum) = IndexRec
  1829.             PrevMastRec = MastRec
  1830.             PrevIndexRec = IndexRec
  1831.             
  1832.           END IF
  1833.         ELSE
  1834.           
  1835.           GOTO endCkeys
  1836.           
  1837.         END IF
  1838.         
  1839.       NEXT lineNum
  1840.       
  1841.       RETURN
  1842.       
  1843. GetLastCpage:
  1844.       
  1845.       key$ = DispLine$(1)
  1846.       MastRec = TempMasREC(1)
  1847.       
  1848.       FOR lineNum = 1 TO height
  1849.         TempMasREC(lineNum) = 0
  1850.         TempIdxREC(lineNum) = 0
  1851.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1852.       NEXT lineNum
  1853.       
  1854.       PIM "P", indexnum, key$, MastRec, IndexRec
  1855.       
  1856.       IF IndexRec THEN
  1857.         
  1858.         GOSUB getrecinfo
  1859.         DispLine$(height) = DispLine$
  1860.         TempMasREC(height) = MastRec
  1861.         TempIdxREC(height) = IndexRec
  1862.       ELSE
  1863.         GOTO homeCkeys
  1864.       END IF
  1865.       
  1866.       PrevMastRec = MastRec
  1867.       PrevIndexRec = IndexRec
  1868.       CurrentROW = 1
  1869.       
  1870. GetLastCpg:
  1871.       
  1872.       FOR lineNum = 1 TO height - 1
  1873.         TempMasREC(lineNum) = 0
  1874.         TempIdxREC(lineNum) = 0
  1875.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1876.       NEXT lineNum
  1877.       
  1878.       FOR lineNum = height - 1 TO 1 STEP -1
  1879.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  1880.         
  1881.         PIM "P", indexnum, key$, MastRec, IndexRec
  1882.         
  1883.         IF IndexRec > 0 THEN
  1884.           IF PrevIndexRec = IndexRec AND PrevMastRec = MastRec THEN
  1885.             GOTO homeCkeys
  1886.           ELSE
  1887.             GOSUB getrecinfo
  1888.             DispLine$(lineNum) = DispLine$
  1889.             TempMasREC(lineNum) = MastRec
  1890.             TempIdxREC(lineNum) = IndexRec
  1891.             PrevMastRec = MastRec
  1892.             PrevIndexRec = IndexRec
  1893.             
  1894.           END IF
  1895.         END IF
  1896.       NEXT lineNum
  1897.       
  1898.       RETURN
  1899.       
  1900. getrecinfo:     'add if more than key RecField is displayed
  1901.       '
  1902.       GET #datfile, MastRec, RecField
  1903.       
  1904.       cnam$ = RecField.name
  1905.       Cnum$ = RecField.Num
  1906.       'RecField.progname
  1907.       'RecField.length
  1908.       cph1$ = RecField.format
  1909.       'trim tint$
  1910.       'RecField.type
  1911.       'RecField.case
  1912.       'RecField.decimal
  1913.       'RecField.comment
  1914.       'RecField.erow
  1915.       tcap$ = RecField.ecol
  1916.       
  1917.       '      IF indexnum = 1 THEN
  1918.       DispLine$ = cnam$  'add$' + " " + cph1$
  1919.       '       ELSE
  1920.       '       DispLine$ = cln$ + " " + tcap$
  1921.       '      END IF
  1922.       RETURN
  1923.       
  1924.     END SUB
  1925.  
  1926.     SUB seldatafile
  1927.       mainscreen
  1928.       MsgLine "Press  " + CHR$(24) + " for last " + CHR$(25) + " for next  ENTER to select", 25, 0, 7
  1929.       
  1930.       DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  1931.       CenterText "Select RecField Database", 22, BLACK, WHITE
  1932. tryagian:
  1933.       filespec$ = SelFiles$("*.FLD")
  1934.       delimit = INSTR(filespec$, ".")
  1935.       
  1936.       IF delimit THEN
  1937.         FileName$ = LEFT$(filespec$, delimit - 1)
  1938.         fileext$ = RIGHT$(filespec$, LEN(filespec$) - (delimit))
  1939.       ELSE
  1940.         FileName$ = filespec$
  1941.         fileext$ = ".FLD"
  1942.       END IF
  1943.       
  1944.       Trim FileName$
  1945.       IF FileName$ = "" THEN
  1946.         MASTERFILE$ = ""
  1947.       ELSE
  1948.         MASTERFILE$ = FileName$ + "." + fileext$
  1949.       END IF
  1950.       
  1951.     END SUB
  1952.  
  1953.