home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / BASIC / PROGEN / PROSRC.ZIP / PROGEN71.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-10-09  |  63.7 KB  |  2,463 lines
  1. DECLARE SUB PROSRC.1 ()
  2. DECLARE SUB PROSRC.2 ()
  3. DECLARE SUB PROSRC.3 ()
  4. DECLARE SUB PROSRC.9 ()
  5. DECLARE SUB PROSRC.CASE.1 ()
  6. DECLARE SUB PROSRC.CASE.2.1 ()
  7. DECLARE SUB PROSRC.CASE.2.2 ()
  8. DECLARE SUB PROSRC.CASE.3.1 ()
  9. DECLARE SUB PROSRC.CASE.3.3 ()
  10. DECLARE SUB PROSRC.CASE.3.4 ()
  11. DECLARE SUB PROSRC.CASE.3.5 ()
  12. DECLARE SUB PROSRC.CASE.4.1 ()
  13. DECLARE SUB PROSRC.CASE.4.2 ()
  14. DECLARE SUB PROSRC.CASE.5.0 ()
  15. DECLARE SUB PROSRC.CASE.6 ()
  16. DECLARE SUB PROSRC.CASE.7.1 ()
  17. DECLARE SUB PROSRC.CASE.7.2 ()
  18. DECLARE SUB PROSRC.INFO.1 (NS%, pf$)
  19. DECLARE SUB PROSRC.SCN.1 (NS%, pf$)
  20. DECLARE SUB PROGEN71.INFO.1 (NS%, pf$)
  21. DECLARE SUB noreport ()
  22. DECLARE SUB buildscreen ()
  23. DECLARE SUB clearscreen ()
  24. DECLARE SUB createdatafile ()
  25. DECLARE SUB genprogram ()
  26. DECLARE SUB initindex ()
  27. DECLARE SUB RecFieldselect (indexnum%, key$, MastRec%, IndexRec%, exitcode%)
  28. DECLARE SUB seldatafile ()
  29. DECLARE SUB PROGEN71.1 ()
  30. DECLARE SUB PROGEN71.2 ()
  31. DECLARE SUB PROGEN71.3 ()
  32. DECLARE SUB PROGEN71.9 ()
  33. DECLARE SUB PROGEN71.CASE.1 ()
  34. DECLARE SUB PROGEN71.CASE.2.1 ()
  35. DECLARE SUB PROGEN71.CASE.2.2 ()
  36. DECLARE SUB PROGEN71.CASE.3.1 ()
  37. DECLARE SUB PROGEN71.CASE.3.3 ()
  38. DECLARE SUB PROGEN71.CASE.3.4 ()
  39. DECLARE SUB PROGEN71.CASE.3.5 ()
  40. DECLARE SUB PROGEN71.CASE.4.1 ()
  41. DECLARE SUB PROGEN71.CASE.4.2 ()
  42. DECLARE SUB PROGEN71.CASE.5.0 ()
  43. DECLARE SUB PROGEN71.CASE.6 ()
  44. DECLARE SUB PROGEN71.CASE.7.1 ()
  45. DECLARE SUB PROGEN71.CASE.7.2 ()
  46. DECLARE SUB DispRecField (temp AS ANY)
  47. DECLARE SUB mainscreen ()
  48. DECLARE SUB maxfields ()
  49. DECLARE SUB nodata ()
  50. DECLARE SUB noscreen ()
  51. DECLARE SUB PROGEN71.SCN.1 (NS%, pf$)
  52. DECLARE FUNCTION strval$ (a%)
  53. DECLARE SUB PIM (cmd$, indexnum%, key$, MastRec%, CurrentIndexREC%)
  54. DECLARE SUB PIMClose (indexnum%, file$)
  55. DECLARE SUB PIMCreate (indexnum%, file$, keylength%, mfile$)
  56. DECLARE SUB PIMdelkey (IxNum%, temp$, MastRec%, IndexRec%)
  57. DECLARE SUB PIMOpen (indexnum%, file$)
  58. DECLARE SUB formatinfo ()
  59. DECLARE SUB proginfo1 ()
  60. DECLARE SUB proginfo2 ()
  61. DECLARE SUB PROBRO.1 ()
  62. DECLARE FUNCTION PIMstats% (indexnum%)
  63.  
  64.  DEFINT A-Z
  65.  
  66. '         Microsoft BASIC 7.1, Professional Development System
  67. '            Copyright (C) 1987-1989, Microsoft Corporation
  68. '
  69. '         Microsoft QBX 7.1, Professional Development System
  70. '            Copyright (C) 1987-1989, Microsoft Corporation
  71. '
  72. '            PROGEN71.bas, PROGEN71.qlb
  73. '            1991 by: RAYMOND E DIXON
  74. '
  75. '                  RAYMOND E DIXON
  76. '                  11660 VC JOHNSON RD.
  77. '                  Jacksonville, Fl. 32218
  78. '
  79. '                  (904) 765-4048
  80.  TYPE RecordType
  81.   status      AS STRING * 1  'First element is in use flag
  82.   Num         AS STRING * 3
  83.   name        AS STRING * 16  '(in order for alphabetical sort)
  84.   type        AS STRING * 1
  85.   case        AS STRING * 1
  86.   key         AS STRING * 1
  87.   decimal     AS STRING * 2
  88.   length      AS STRING * 2
  89.   format      AS STRING * 50
  90.   frow        AS STRING * 2
  91.   fcol        AS STRING * 2
  92.   progname    AS STRING * 8
  93.   comment     AS STRING * 30
  94.   recnum      AS INTEGER
  95.   ppos        AS STRING * 2
  96.   pline       AS STRING * 2
  97.   DUM         AS STRING * 10
  98.   END TYPE
  99.  
  100. COMMON SHARED masterFile$, numberoffields, ff, progfile$, startp
  101.  
  102. ' $INCLUDE: 'PROLIB71.BI'
  103. STACK 4000
  104. '$DYNAMIC
  105.  
  106.   DIM SHARED scrnline$(25)  ' Lines 1-24
  107.   DIM SHARED RecField AS RecordType
  108.   DIM SHARED formatsel1$(16)
  109.   DIM SHARED formatsel2$(16)
  110.   DIM SHARED fieldpointer%(25, 80)  ' Frame for input markers
  111.   DIM SHARED fl$(25)   ' File array, 2nd Key Select Array
  112.   DIM SHARED dialog$(20)
  113.   DIM SHARED omenu$(10)
  114.   DIM SHARED TestRecField AS RecordType
  115.   DIM SHARED DispLine$(30)
  116.   DIM SHARED Findex(50) AS RecordType
  117.  
  118.   fg = WHITE
  119.   bg = BLUE
  120.   rev = RED
  121.  
  122.   LOCATE 25, 1, 0, 0, 0
  123.   COLOR WHITE, BLUE
  124.  
  125.   CONST RecFieldNameIDX = 1
  126.   CONST RecFieldNumIDX = 2
  127.   CONST datfile = 3
  128.   CONST infofile = 4
  129.   mainscreen
  130.   MsgLine "Press  " + CHR$(24) + " for last " + CHR$(25) + " for next  ENTER to select", 25, 0, 7
  131.  
  132.   DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  133.   CenterText "Select Program Database", 22, BLACK, WHITE
  134.  
  135. redo:
  136.  
  137.   fl$ = "SAMPLE PROGRAM\"
  138.   fl$ = fl$ + "USER   PROGRAM\"
  139.   fl$ = fl$ + "NEW    PROGRAM\"
  140.  
  141.   Dopt = MenuWindow(0, 0, fl$, "SELECT ", BLACK, WHITE, RED, 0)
  142.  
  143. 'Get the option
  144.  
  145.   SELECT CASE Dopt  'Select on choice
  146.    CASE 1
  147.     masterFile$ = "SAMPLE.FLD"
  148.    CASE 2
  149.     seldatafile
  150.    CASE 3
  151.     CLOSE
  152.     createdatafile
  153.    CASE ELSE
  154.   END SELECT
  155.  
  156.   IF masterFile$ = "" THEN
  157.    GOTO redo
  158.   END IF
  159.  
  160. NEWFILE:
  161.  
  162.   IF FileExists(masterFile$) = 0 THEN  'If no index then create
  163.  
  164.    PIMCreate RecFieldNameIDX, masterFile$, 16, masterFile$ 'Create a RecField date INDEX
  165.    PIMCreate RecFieldNumIDX, masterFile$, 3, masterFile$  'Create a RecField date INDEX
  166.  
  167.   END IF
  168.  
  169.   PIMOpen RecFieldNameIDX, masterFile$   'Open Index
  170.   PIMOpen RecFieldNumIDX, masterFile$   'Open Index
  171.  
  172.   OPEN masterFile$ FOR RANDOM AS datfile LEN = LEN(RecField)  'Open the data file
  173.  
  174.   initindex
  175.   delimit = INSTR(masterFile$, ".")
  176.  
  177.   IF delimit THEN
  178.    RecField.progname = LEFT$(masterFile$, delimit - 1)
  179.   ELSE
  180.    RecField.progname = masterFile$
  181.   END IF
  182.  
  183.   programname$ = RTRIM$(RecField.progname) + ".inf"
  184.   
  185.   IF FileExists(programname$) = 0 THEN  'If no index then create
  186.   OPEN programname$ FOR OUTPUT AS infofile
  187.   PRINT #infofile, numberoffields, numberofscreens, numberofreports
  188.   CLOSE infofile
  189.   ELSE
  190.   OPEN programname$ FOR INPUT AS infofile
  191.   INPUT #infofile, numberoffields, numberofscreens, numberofreports
  192.   CLOSE infofile
  193.   END IF
  194.  
  195.   DO
  196.    mainscreen
  197.    DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  198.    CenterText " Current Data File : " + masterFile$, 22, BLACK, WHITE
  199.  
  200.            menu$ = "1 - Add a new RecField #\"
  201.    menu$ = menu$ + "2 - Browse/Edit RecField #'s\"
  202.    menu$ = menu$ + "3 - Print by RecField #\"
  203.    menu$ = menu$ + "4 - Delete (remove) a RecField #\"
  204.    menu$ = menu$ + "5 - Erase RecField datafile\"
  205.    menu$ = menu$ + "6 - Change RecField datafile\"
  206.    menu$ = menu$ + "7 - New RecField datafile (create)\"
  207.    menu$ = menu$ + "8 - System Information\"
  208.    menu$ = menu$ + "B - Generate BASIC Program\"
  209.    menu$ = menu$ + "S - Generate SCREENS\"
  210.    menu$ = menu$ + "R - Generate REPORT\"
  211.    menu$ = menu$ + "Q - Quit Program\"
  212.  
  213.    mopt = MenuWindow(0, 0, menu$, "Main Menu", BLACK, WHITE, RED, 0)
  214.  
  215. 'Get the option
  216.  
  217.    SELECT CASE mopt  'Select on choice
  218.  
  219.     CASE 1  'Insert a new NAME
  220.      mainscreen
  221.      IF numberoffields <= 10 THEN
  222.       GOSUB InitRecField
  223.       DispRecField RecField
  224.       GOSUB RecFielddetails
  225.      ELSE
  226.       maxfields
  227.      END IF
  228.  
  229.     CASE 2  'Browse through RecField date
  230.  
  231.      Imopt = 1
  232.      mainscreen
  233.      DO
  234.       RecFieldselect RecFieldNumIDX, key$, curmasrec, IndexRec, exitcode
  235.  
  236.       IF exitcode = 0 THEN
  237.        nodata
  238.        EXIT DO
  239.       END IF
  240.  
  241.       IF exitcode = 1 THEN
  242.        EXIT DO
  243.       END IF
  244.  
  245.       WHILE exitcode = 2
  246.  
  247.        GET #datfile, curmasrec, RecField
  248.  
  249.        DispRecField RecField
  250.        ixv = RecFieldNumIDX
  251.  
  252.        BO$ = "    Next    Prev    Search    Edit   Formats" + CHR$(255) + "information    Menu        "
  253.  
  254.        Imopt = MenuBar(25, 3, BO$, BLACK, WHITE, RED, Imopt)
  255.  
  256.        IF Imopt = 3 THEN
  257.         exitcode = 0
  258.        END IF
  259.  
  260.        IF Imopt = 4 THEN
  261.  
  262.         mopt = 2
  263.  
  264.         Oldname$ = RecField.name
  265.         Oldnum$ = RecField.Num
  266.  
  267.         GOSUB RecFielddetails
  268.  
  269.        END IF
  270.  
  271.        IF Imopt = 5 THEN
  272.  
  273.         formatinfo
  274.         proginfo1
  275.         proginfo2
  276.         mainscreen
  277.  
  278.        END IF
  279.  
  280.        IF Imopt = 6 THEN
  281.         EXIT DO
  282.        END IF
  283.  
  284.        IF Imopt = 1 THEN
  285.         PIM "N", ixv, nul$, curmasrec, IndexRec
  286.        END IF
  287.  
  288.        IF Imopt = 2 THEN
  289.         PIM "P", ixv, nul$, curmasrec, IndexRec
  290.        END IF
  291.  
  292.       WEND
  293.      LOOP
  294.  
  295.     CASE 3  'PRINT DATA
  296.  
  297.      DO
  298.       IF PIMstats(1) = 0 THEN
  299.        DispLine$(1) = "There are RecFields in the database "
  300.        DispLine$(2) = ""
  301.        DispLine$(3) = "Press any key to continue"
  302.        Message DispLine$(), 3, 3, BLACK, WHITE, BLACK, WHITE
  303.  
  304.        GOTO norec
  305.  
  306.       END IF
  307.  
  308.       DispLine$(1) = "Enter Starting RecField"
  309.       DispLine$(2) = "Enter for all"
  310.       ans$ = ""
  311.  
  312.       nl = LEN(RecField.Num)
  313.  
  314.       DialogBox DispLine$(), 1, 1, nl, BLACK, WHITE, BLACK, WHITE, 1, ans$, "", Exk
  315.       key$ = ans$
  316.       DispLine$(1) = "Print to Display or Printer"
  317.       Ques$ = "(D/P)"
  318.       answ$ = "DdPp"
  319.       AskQuestion DispLine$(), 1, 1, 1, BLACK, WHITE, BLACK, WHITE, Ques$, answ$
  320.  
  321.       IF UCASE$(answ$) = "D" THEN
  322.        output$ = "CONS:"
  323.        CLS
  324.       ELSE
  325.        output$ = "LPT1:"
  326.        IF CheckPrinter <> 1 THEN
  327.         EXIT DO
  328.        END IF
  329.       END IF
  330.  
  331.       prt = FREEFILE
  332.  
  333.       OPEN output$ FOR OUTPUT AS #prt
  334.       WIDTH #prt, 80
  335.       IxNum = 2  'Print the DB in Last Name sequence
  336.       PIM "S", IxNum, key$, MastRec, IndexRec
  337.       tempindex = IndexRec
  338.  
  339. 'No Ckeys in the index
  340.  
  341.       IF IndexRec THEN
  342.        GET #datfile, MastRec, RecField
  343.        pfn$ = RecField.name
  344.        pfl$ = RecField.length
  345.        pft$ = RecField.type
  346.        pfk$ = RecField.key
  347.        pfc$ = RecField.case
  348.        pfd$ = RecField.decimal
  349.        pff$ = RecField.format
  350.        pfrow$ = RecField.frow
  351.        pfcol$ = RecField.fcol
  352.  
  353.        PRINT #prt, "FIELD NAME  " + " LENGTH " + " KEY " + " TYPE " + " CASE " + " DECIMAL " + "ROW-COL" + " FORMAT"
  354.        PRINT #prt, STRING$(80, "-");
  355.        PRINT #prt, pfn$ + " " + pfl$ + "   " + pfk$ + "    " + pft$ + "     " + pfc$ + "      " + pfd$ + "      " + pfrow$ + " " + pfcol$ + " " + pff$
  356.  
  357.        DO WHILE IndexRec
  358.  
  359.         PIM "N", IxNum, key$, MastRec, IndexRec
  360.         IF tempindex = IndexRec THEN
  361.          EXIT DO
  362.         END IF
  363.  
  364.         IF IndexRec > 0 THEN
  365.          IF PrevMastRec = MastRec AND IndexRec = PrevIndexRec THEN
  366.           EXIT DO
  367.          ELSE
  368.  
  369.           GET #datfile, MastRec, RecField
  370.  
  371.           pfn$ = RecField.name
  372.           pfl$ = RecField.length
  373.           pft$ = RecField.type
  374.           pfk$ = RecField.key
  375.           pfc$ = RecField.case
  376.           pfd$ = RecField.decimal
  377.           pff$ = RecField.format
  378.           pfrow$ = RecField.frow
  379.           pfcol$ = RecField.fcol
  380.  
  381.           PRINT #prt, pfn$ + " " + pfl$ + "   " + pfk$ + "    " + pft$ + "     " + pfc$ + "      " + pfd$ + "      " + pfrow$ + " " + pfcol$ + " " + pff$
  382.  
  383.           PrevMastRec = MastRec
  384.           PrevIndexRec = IndexRec
  385.  
  386.          END IF
  387.         END IF
  388.        LOOP
  389.  
  390.        IF output$ = "LPT1:" THEN
  391.         PRINT #prt, CHR$(12)
  392.        ELSE
  393.         waitkey 24, fg, bg
  394.        END IF
  395.        CLOSE #prt
  396.        EXIT DO
  397.       END IF
  398.  
  399.      LOOP
  400. norec:
  401.     CASE 4  'Delete (remove) a field
  402.  
  403.      DO
  404.       RecFieldselect RecFieldNumIDX, key$, curmasrec, IndexRec, exitcode
  405.  
  406.       IF exitcode = 0 THEN  'Index is Empty
  407.        nodata
  408.        EXIT DO
  409.       END IF
  410.  
  411.       IF curmasrec > 0 AND IndexRec > 0 THEN
  412.  
  413.        IF curmasrec THEN
  414.         GET #datfile, curmasrec, RecField  'Get the details,
  415. 'display the details
  416.         DispRecField RecField
  417.  
  418.         DispLine$(1) = "YES, go ahead and delete displayed record   : " + RecField.name
  419.         DispLine$(2) = "NO, I don't want to delete displayed record : " + RecField.name
  420.  
  421.         Imopt = 1
  422.         Ques$ = "(Y/N)"
  423.         answ$ = "YyNn"
  424.  
  425.         AskQuestion DispLine$(), 2, 1, 2, BLACK, WHITE, BLACK, WHITE, Ques$, answ$
  426.  
  427.         IF UCASE$(answ$) = "Y" THEN
  428.  
  429.          Oldname$ = RecField.name
  430.          Oldnum$ = RecField.Num
  431.  
  432.          MastRec = curmasrec
  433.  
  434.          Trim Oldname$
  435.          Trim Oldnum$
  436.  
  437.          PIMdelkey RecFieldNumIDX, Oldnum$, MastRec, IndexRec
  438.  
  439.          MastRec = curmasrec
  440.  
  441.          PIMdelkey RecFieldNameIDX, Oldname$, MastRec, IndexRec
  442.  
  443.          GOSUB InitRecField  'Initialize NAME
  444.  
  445.          RecField.status = "F"  'Set flag to free
  446.  
  447.          PUT #datfile, MastRec, RecField  'Write blank Record
  448.  
  449.         END IF  'Done
  450.         EXIT DO
  451.        END IF
  452.       ELSE
  453.        EXIT DO
  454.       END IF
  455.      LOOP
  456.  
  457.     CASE 5  'DELETE ALL OF THE FILES
  458.  
  459.      DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  460.  
  461.      CenterText "Select File to Delete ", 22, BLACK, WHITE
  462.      MsgLine "Press  " + CHR$(24) + " for last " + CHR$(25) + " for next  ENTER to select", 25, 0, 7
  463.  
  464.      mfile$ = SelFiles$("*.FLD")
  465.  
  466.      Trim mfile$
  467.      masterFile$ = mfile$
  468.  
  469.      IF mfile$ <> "" THEN
  470.       DispLine$(1) = "Delete " + mfile$ + ", Are You Sure ?"
  471.       DispLine$(2) = "Yes to erase Field Database"
  472.       Ques$ = "(Y/N)"
  473.       ans$ = "YyNn"
  474.  
  475.       AskQuestion DispLine$(), 2, 1, 1, BLACK, WHITE, BLACK, WHITE, Ques$, ans$
  476.  
  477.       IF UCASE$(ans$) = "Y" THEN
  478.  
  479.        PIMClose RecFieldNameIDX, masterFile$
  480.        PIMClose RecFieldNumIDX, masterFile$
  481.  
  482.        CLOSE
  483.  
  484.        delimit = INSTR(masterFile$, ".")
  485.  
  486.        IF delimit THEN
  487.         masterFile$ = LEFT$(masterFile$, delimit - 1)
  488.        END IF
  489.  
  490.        KILL masterFile$ + ".FLD"
  491.        KILL masterFile$ + ".F1"
  492.        KILL masterFile$ + ".F2"
  493.        seldatafile
  494.  
  495.        IF masterFile$ = "" THEN
  496.         createdatafile
  497.        END IF
  498.        GOTO NEWFILE
  499.  
  500.       END IF
  501.      END IF
  502.  
  503.     CASE 6
  504.  
  505.      PIMClose RecFieldNameIDX, masterFile$
  506.      PIMClose RecFieldNumIDX, masterFile$   'Open Index
  507.      CLOSE
  508. 'Get the option
  509.  
  510.            fl$ = "SAMPLE PROGRAM\"
  511.      fl$ = fl$ + "USER   PROGRAM\"
  512.  
  513.      Dopt = MenuWindow(0, 0, fl$, "SELECT", BLACK, WHITE, RED, 0)
  514.  
  515.      SELECT CASE Dopt  'Select on choice
  516.       CASE 1
  517.        masterFile$ = "SAMPLE.FLD"
  518.       CASE 2
  519.        seldatafile
  520.       CASE ELSE
  521.      END SELECT
  522.  
  523.      GOTO NEWFILE
  524.  
  525.     CASE 7
  526.  
  527.      PIMClose RecFieldNameIDX, masterFile$
  528.      PIMClose RecFieldNumIDX, masterFile$
  529.      CLOSE
  530.      createdatafile
  531.      GOTO NEWFILE
  532.  
  533.     CASE 8
  534.  
  535.      workREC& = LOF(datfile)
  536.      LastREC = CINT(workREC& / LEN(RecField))
  537.      DspEquipment
  538.  
  539.     CASE 9  'generate basic program
  540.      CALL genprogram
  541.  
  542.     CASE 10  'generate screens
  543.      'CALL buildscreen
  544.      RUN "proscn71"
  545.     CASE 11  'generate screens
  546.      'CALL buildreport
  547.      'RUN "prorpt71"
  548.     CASE 12  'QUIT
  549.      
  550.      PIMClose RecFieldNameIDX, masterFile$
  551.      PIMClose RecFieldNumIDX, masterFile$
  552.  
  553.      OPEN programname$ FOR OUTPUT AS infofile
  554.      PRINT #infofile, numberoffields, numberofscreens, numberofreports
  555.      CLOSE
  556.  
  557.      EXIT DO
  558.  
  559.     CASE 99
  560.     CASE ELSE
  561.    END SELECT
  562.   LOOP
  563.  
  564.   LOCATE 23, 1
  565.   COLOR WHITE, BLACK
  566.   CLS
  567.   END  'End of program
  568.  
  569. RecFielddetails: 'Get Details
  570.  
  571.   op = 2
  572.   fg = BLACK
  573.   bg = WHITE
  574.  
  575.   DO
  576.  
  577.    SELECT CASE op
  578.  
  579.     CASE 1
  580.  
  581.      pnc "ESC to exit PgDn TO update, " + CHR$(24) + " for prev " + CHR$(25) + " for next F1 edit help", 22, 10, 0, 7
  582.  
  583.      edit$ = RecField.Num
  584.      Trim edit$
  585. getnum:
  586.      LOCATE 8, 21
  587.      format$ = STRING$(LEN(RecField.Num), "9")
  588.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 0, Ek, 1, 0, 1, 1, 1, 1, 1, 0)
  589.  
  590.      RecField.Num = edit$
  591.  
  592.      SELECT CASE Ek
  593.       CASE 1
  594.        op = 9
  595.       CASE 5
  596.        op = op + 1
  597.       CASE 3
  598.        op = op + 1
  599.       CASE 4
  600.        op = 10
  601.       CASE 7
  602.        op = 999
  603.      END SELECT
  604.  
  605.      IF edit$ = "" AND Ek <> 7 THEN
  606.       GOTO getnum
  607.      END IF
  608.  
  609.     CASE 2
  610.      MsgLine "  ESC to exit PgDn TO update, " + CHR$(24) + " for prev " + CHR$(25) + " for next F1 edit help", 25, 0, 7
  611.  
  612.      op = 2
  613.      edit$ = RecField.name
  614.      Trim edit$
  615. getname:
  616.      LOCATE 9, 21
  617.      format$ = STRING$(LEN(RecField.name), "#")
  618.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 1, Ek, 1, 0, 1, 1, 1, 1, 1, 0)
  619.  
  620.      RecField.name = edit$
  621.  
  622.      IF edit$ = "" AND Ek <> 7 THEN
  623.       GOTO getname
  624.      END IF
  625.  
  626.      SELECT CASE Ek
  627.       CASE 1
  628.        op = 9
  629.       CASE 5
  630.        op = op + 1
  631.       CASE 3
  632.        op = op + 1
  633.       CASE 4
  634.        op = 10
  635.       CASE 7
  636.        op = 999
  637.      END SELECT
  638.  
  639.    '  edit$ = RecField.frow
  640.    '  Trim edit$
  641.    '  pnc edit$, 16, 21, fg, bg
  642.    '  RecField.frow = edit$
  643.    '  edit$ = RecField.fcol
  644.    '  Trim edit$
  645.    '  RecField.fcol = edit$
  646.      pnc RecField.frow, 16, 21, fg, bg
  647.      pnc RecField.fcol, 17, 21, fg, bg
  648.  
  649.     CASE 3
  650.  
  651.      edit$ = RecField.key
  652.      Trim edit$
  653.      LOCATE 10, 21
  654.      format$ = STRING$(LEN(RecField.key), "#")
  655.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 1, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  656.  
  657.      SELECT CASE Ek
  658.       CASE 1
  659.        op = op - 1
  660.       CASE 5
  661.        op = op + 1
  662.       CASE 3
  663.        op = op + 1
  664.       CASE 4
  665.        op = 10
  666.       CASE 7
  667.        op = 999
  668.      END SELECT
  669.  
  670.      RecField.key = edit$
  671.  
  672.     CASE 4
  673.  
  674.       formatsel1$(1) = "@@@@@@@@@@@@@ ALPHA ONLY"
  675.       formatsel1$(2) = "############# ALPHANUMERIC"
  676.       formatsel1$(3) = "9999999999999 NUMERIC ONLY"
  677.       formatsel1$(4) = "(999) 999-999 PHONE(10)"
  678.       formatsel1$(5) = "999-9999      PHONE(7)"
  679.       formatsel1$(6) = "999-99-9999   SS"
  680.       formatsel1$(7) = "99999-9999    ZIP(9)"
  681.       formatsel1$(8) = "99999         ZIP(5)"
  682.       formatsel1$(9) = "19/39/99      mm/dd/yy"
  683.      formatsel1$(10) = "99999         INTEGER"
  684.      formatsel1$(11) = "9999999       LONG"
  685.      formatsel1$(12) = "99999.99      SINGLE"
  686.      formatsel1$(13) = "99999.99      DOUBLE"
  687.      formatsel1$(14) = "99999.99      CURRENCY"
  688.      formatsel1$(15) = "USER          Format"
  689.  
  690.      rfl = 34  'VAL(LTRIM$(RecField.length))
  691.  
  692.      formatsel2$(1) = STRING$(rfl, "@")
  693.      formatsel2$(2) = STRING$(rfl, "#")
  694.      formatsel2$(3) = STRING$(rfl, "9")
  695.      formatsel2$(4) = "(999) 999-9999"
  696.      formatsel2$(5) = "999-9999"
  697.      formatsel2$(6) = "999-99-9999"
  698.      formatsel2$(7) = "99999-9999"
  699.      formatsel2$(8) = "99999"
  700.      formatsel2$(9) = "19/39/99"
  701.      formatsel2$(10) = "99999"
  702.      formatsel2$(11) = "99999"
  703.      formatsel2$(12) = "999.99"
  704.      formatsel2$(13) = "999.99"
  705.      formatsel2$(14) = "999.99"
  706.  
  707.      nums = 15
  708.  
  709.      usel = SelBox(formatsel1$(), nums, 10, 26, BLACK, WHITE, RED)
  710.      edit$ = formatsel2$(usel)
  711.  
  712.      SELECT CASE usel
  713.       CASE 1
  714.        RecField.format = formatsel2$(usel)
  715.        RecField.type = "A"
  716.  
  717.       CASE 2
  718.        RecField.format = formatsel2$(usel)
  719.        RecField.type = "B"
  720.  
  721.       CASE 3
  722.        RecField.format = formatsel2$(usel)
  723.        RecField.type = "N"
  724.       CASE 4
  725.        RecField.length = LTRIM$(STR$(10))
  726.        op = 8  'op + 1
  727.       CASE 5
  728.        RecField.length = LTRIM$(STR$(7))
  729.        op = 8  'op + 1
  730.       CASE 6
  731.        RecField.length = LTRIM$(STR$(9))
  732.        op = 8  'op + 1
  733.       CASE 7
  734.        RecField.length = LTRIM$(STR$(9))
  735.        op = 8  'op + 1
  736.       CASE 8
  737.        RecField.length = LTRIM$(STR$(5))
  738.        op = 8  'op + 1
  739.       CASE 9
  740.        RecField.length = LTRIM$(STR$(6))
  741.        op = 8  'op + 1
  742.       CASE 10
  743.        RecField.type = "I"
  744.        RecField.format = formatsel2$(usel)
  745.  
  746.       CASE 11
  747.        RecField.type = "L"
  748.        RecField.format = formatsel2$(usel)
  749.  
  750.       CASE 12
  751.        RecField.type = "S"
  752.        RecField.format = formatsel2$(usel)
  753.  
  754.       CASE 13
  755.        RecField.type = "D"
  756.        RecField.format = formatsel2$(usel)
  757.  
  758.       CASE 14
  759.        RecField.type = "C"
  760.        RecField.format = formatsel2$(usel)
  761.  
  762.       CASE 15
  763.        RecField.length = LTRIM$(STR$(5))
  764.        op = 8  'op + 1
  765.      END SELECT
  766.  
  767.      format$ = STRING$(34, "#")
  768.      Trim edit$
  769.  
  770. newformat:
  771.      LOCATE 11, 21
  772.      pnc "Field Format:                                ", 11, 8, fg, bg
  773.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 0, Ek, 1, 0, 1, 1, 1, 0, 1, 1)
  774.      pnc "Field Length:                                ", 12, 8, fg, bg
  775.      pnc RecField.length, 12, 21, fg, bg
  776.  
  777.      RecField.format = edit$
  778.  
  779.      SELECT CASE Ek
  780.       CASE 1
  781.        op = op - 1
  782.       CASE 5
  783.        op = op + 1
  784.       CASE 3
  785.        op = op + 1
  786.       CASE 4
  787.        op = 10
  788.       CASE 7
  789.        op = 999
  790.      END SELECT
  791.  
  792.     CASE 5
  793. getadd:
  794.  
  795.      edit$ = RecField.length
  796.      Trim edit$
  797.      LOCATE 12, 21
  798.      format$ = "99"
  799.  
  800.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 1, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  801.  
  802.      RecField.length = edit$
  803.      Trim edit$
  804.      rfl = VAL(edit$)
  805.  
  806.      formatsel$(1) = STRING$(rfl, "@")
  807.      formatsel$(2) = STRING$(rfl, "#")
  808.      formatsel$(3) = STRING$(rfl, "9")
  809.  
  810.      SELECT CASE usel
  811.  
  812.       CASE 1
  813.        RecField.format = formatsel$(1)
  814.        RecField.case = "A"
  815.       CASE 2
  816.        RecField.format = formatsel$(2)
  817.        RecField.case = "B"
  818.       CASE 3, 10, 11, 12, 13, 14
  819.        RecField.format = formatsel$(3)
  820.        RecField.case = "N"
  821.      END SELECT
  822.  
  823.      pnc "Field Format:                                  ", 11, 8, fg, bg
  824.      pnc RecField.format, 11, 21, fg, bg
  825.  
  826.      SELECT CASE Ek
  827.       CASE 1
  828.        op = op - 1
  829.       CASE 5
  830.        op = op + 1
  831.       CASE 3
  832.        op = op + 1
  833.       CASE 4
  834.        op = 10
  835.       CASE 7
  836.        op = 999
  837.      END SELECT
  838.  
  839.     CASE 6
  840.  
  841.      edit$ = RecField.type
  842.      Trim edit$
  843.      LOCATE 13, 21
  844.      format$ = STRING$(LEN(RecField.type), "#")
  845.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 1, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  846.      RecField.type = edit$
  847.  
  848.      'SELECT CASE edit$
  849.      'CASE "N"
  850.      ' op = 6
  851.      ' RecField.case = "A"
  852.      ' RecField.key = "N"
  853.      'CASE "D"
  854.      'END SELECT
  855.  
  856.      SELECT CASE Ek
  857.       CASE 1
  858.        op = op - 1
  859.       CASE 5
  860.        op = op + 1
  861.       CASE 3
  862.        op = op + 1
  863.       CASE 4
  864.        op = 10
  865.       CASE 7
  866.        op = 999
  867.      END SELECT
  868.  
  869.     CASE 7
  870.  
  871.      edit$ = RecField.case
  872.      Trim edit$
  873.      LOCATE 14, 21
  874.      format$ = STRING$(LEN(RecField.case), "#")
  875.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 1, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  876.      RecField.case = edit$
  877.  
  878.      SELECT CASE Ek
  879.       CASE 1
  880.        op = op - 1
  881.       CASE 5
  882.        op = op + 1
  883.       CASE 3
  884.        op = op + 1
  885.       CASE 4
  886.        op = 10
  887.       CASE 7
  888.        op = 999
  889.      END SELECT
  890.  
  891.     CASE 8
  892.  
  893.      edit$ = RecField.decimal
  894.      Trim edit$
  895.      LOCATE 15, 21
  896.      format$ = "99"
  897.  
  898.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 1, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  899.  
  900.       RecField.decimal = edit$
  901.       Trim edit$
  902.       IF LEN(edit$) THEN
  903.       RecField.format = LEFT$(RecField.format, VAL(RecField.length) - VAL(RecField.decimal)) + "." + STRING$(VAL(RecField.decimal), "9")
  904.       RecField.case = "A"
  905.      END IF
  906.  
  907.      pnc "Field Format:                                  ", 11, 8, fg, bg
  908.      pnc RecField.format, 11, 21, fg, bg
  909.  
  910.      SELECT CASE Ek
  911.       CASE 1
  912.        op = op - 1
  913.       CASE 5
  914.        op = op + 1
  915.       CASE 3
  916.        op = op + 1
  917.       CASE 4
  918.        op = 10
  919.       CASE 7
  920.        op = 999
  921.      END SELECT
  922.  
  923.     CASE 9
  924.  
  925.      edit$ = RecField.comment
  926.      Trim edit$
  927.      LOCATE 18, 21
  928.      format$ = STRING$(LEN(RecField.comment), "#")
  929.      edit$ = FES(0, WHITE, BLACK, edit$, format$, 0, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  930.      RecField.comment = edit$
  931.  
  932.      SELECT CASE Ek
  933.       CASE 1
  934.        op = op - 1
  935.       CASE 5
  936.        op = 2  'OP + 1
  937.       CASE 3
  938.        op = 2  'OP + 1
  939.       CASE 4
  940.        op = 10
  941.       CASE 7
  942.        op = 999
  943.      END SELECT
  944.  
  945.     CASE 10  'END REACHED
  946.  
  947.      test$ = RecField.name
  948.      Trim test$
  949.  
  950.      IF LEN(test$) = 0 THEN
  951.       op = 1
  952.       MsgLine "NAME is key Field, must enter data ", 25, 0, 7
  953.       GOTO getname
  954.      END IF
  955.  
  956.      SELECT CASE mopt  'do option
  957.  
  958. 'INSERT or Change record key
  959.  
  960.       CASE 1  'INSERT
  961.        workREC& = LOF(datfile)
  962.        FreeRec = 0
  963.  
  964.        IF workREC& THEN
  965.         LastREC = CINT(workREC& / LEN(RecField))
  966.         FOR lineNum = 1 TO LastREC
  967.          GET #datfile, lineNum, TestRecField
  968.          IF TestRecField.status = "F" THEN
  969.           FreeRec = lineNum
  970.           EXIT FOR
  971.          END IF
  972.         NEXT lineNum
  973.         IF FreeRec = 0 THEN
  974.          FreeRec = lineNum
  975.         END IF
  976.        ELSE
  977.         FreeRec = 1
  978.        END IF
  979.  
  980.        key$ = RecField.name
  981.  
  982.        PIM "A", RecFieldNameIDX, key$, FreeRec, IndexRec
  983.        IF IndexRec = 0 THEN
  984.         PRINT "Index failure"
  985.         END
  986.        END IF
  987.  
  988.        key$ = RecField.Num
  989.  
  990.        PIM "A", RecFieldNumIDX, key$, FreeRec, IndexRec
  991.        IF IndexRec = 0 THEN
  992.         PRINT "Index failure"
  993.         END
  994.        END IF
  995.  
  996.        RecField.status = "U"
  997.        RecField.recnum = FreeRec
  998.        PUT #datfile, FreeRec, RecField
  999.  
  1000. 'write to disk
  1001.  
  1002.        PIMClose RecFieldNameIDX, masterFile$
  1003.        PIMClose RecFieldNumIDX, masterFile$
  1004.  
  1005.        CLOSE
  1006.        GOTO NEWFILE
  1007.        EXIT DO  'INSERTED!
  1008.  
  1009.       CASE 2  'Edit, Update
  1010.  
  1011.        TemPrevMastRec = curmasrec
  1012.        MastRec = curmasrec
  1013.  
  1014.        Newname$ = RecField.name  'Need copy of key
  1015.  
  1016.        Trim Newname$
  1017.        Trim Oldname$
  1018.  
  1019.        IF Newname$ <> Oldname$ THEN  'Change Key
  1020.         PIM "S", RecFieldNameIDX, Oldname$, MasRECtemp, IndexRec
  1021.         DO
  1022.          IF MasRECtemp = MastRec THEN
  1023.           EXIT DO
  1024.          ELSE
  1025.           PIM "N", RecFieldNameIDX, Oldname$, MasRECtemp, IndexRec
  1026.          END IF
  1027.         LOOP
  1028.  
  1029.         PIM "D", RecFieldNameIDX, Oldname$, MasRECtemp, IndexRec
  1030.         PIM "A", RecFieldNameIDX, Newname$, MastRec, IndexRec
  1031.        END IF
  1032.  
  1033.        TemPrevMastRec = curmasrec
  1034.        MastRec = curmasrec
  1035.  
  1036.        Newnum$ = RecField.Num  'Need copy of key
  1037.  
  1038.        Trim Newnum$
  1039.        Trim Oldnum$
  1040.  
  1041.        IF Newnum$ <> Oldnum$ THEN  'Change Key
  1042.         PIM "S", RecFieldNumIDX, Oldnum$, MasRECtemp, IndexRec
  1043.         DO
  1044.          IF MasRECtemp = MastRec THEN
  1045.           EXIT DO
  1046.          ELSE
  1047.           PIM "N", RecFieldNumIDX, Oldnum$, MasRECtemp, IndexRec
  1048.          END IF
  1049.         LOOP
  1050.  
  1051.         PIM "D", RecFieldNumIDX, Oldnum$, MasRECtemp, IndexRec
  1052.         PIM "A", RecFieldNumIDX, Newnum$, MastRec, IndexRec
  1053.        END IF
  1054.  
  1055.        MastRec = TemPrevMastRec
  1056.        RecField.recnum = MastRec
  1057.        PUT #datfile, MastRec, RecField  'Write the new record
  1058.  
  1059.        EXIT DO
  1060.       CASE ELSE
  1061.      END SELECT
  1062.     CASE 999
  1063.      EXIT DO
  1064.     CASE ELSE
  1065.      END
  1066.    END SELECT
  1067.   LOOP
  1068.  
  1069.   RETURN
  1070.  
  1071. InitRecField: 'Set to blanks
  1072.  
  1073.   RecField.name = ""
  1074.   RecField.Num = LTRIM$(STR$(numberoffields + 1))
  1075.   RecField.length = ""
  1076.   RecField.format = ""
  1077.   RecField.type = ""
  1078.   RecField.case = ""
  1079.   RecField.decimal = ""
  1080.   RecField.frow = ""
  1081.   RecField.fcol = ""
  1082.   RecField.comment = ""
  1083.   RecField.recnum = 0
  1084.  
  1085.   RETURN
  1086.  
  1087.   END
  1088.  
  1089. REM $STATIC
  1090.   SUB createdatafile
  1091.  
  1092. redofile:
  1093.  
  1094.    DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  1095.    CenterText "Enter Name For New Database", 22, BLACK, WHITE
  1096.  
  1097.    MsgOpt$(1) = "Enter new file specification"
  1098.    ans$ = ""
  1099.  
  1100.    DialogBox MsgOpt$(), 1, 1, 8, BLACK, WHITE, BLACK, WHITE, 1, ans$, "", Ek
  1101.    IF Ek = 7 THEN
  1102.     EXIT SUB
  1103.    END IF
  1104.    filespec$ = ans$
  1105.  
  1106.    delimit = INSTR(filespec$, ".")
  1107.  
  1108.    IF delimit THEN
  1109.     FileName$ = LEFT$(filespec$, delimit - 1)
  1110.     fileext$ = RIGHT$(filespec$, LEN(filespec$) - (delimit))
  1111.    ELSE
  1112.     FileName$ = filespec$
  1113.     fileext$ = "FLD"
  1114.    END IF
  1115.  
  1116.    IF LEN(filespec$) = 0 OR LEN(FileName$) > 8 OR LEN(fileext$) > 3 THEN
  1117.     MsgOpt$(1) = "You didn't enter a valid file specification."
  1118.     MsgOpt$(2) = ""
  1119.     MsgOpt$(3) = "Press any key to continue"
  1120.     Message MsgOpt$(), 3, 3, BLACK, WHITE + 8, BLACK, WHITE
  1121.     GOTO redofile
  1122.    END IF
  1123.    Trim FileName$
  1124.    masterFile$ = FileName$ + "." + fileext$
  1125.  
  1126.   END SUB
  1127.  
  1128.   SUB DispRecField (temp AS RecordType)
  1129.      
  1130. 'Display details on screen
  1131.  
  1132.    fg = BLACK
  1133.    bg = WHITE
  1134.  
  1135.    TopRow = 7
  1136.    LeftCol = 5
  1137.    botrow = 20
  1138.    rightcol = 74
  1139.    FrameType = 2
  1140.  
  1141. 'draw frame
  1142.  
  1143.    CALL drawwind(TopRow, LeftCol, botrow, rightcol, FrameType, 1)
  1144. 'color frame
  1145.    CALL Colorwind(TopRow, LeftCol, botrow, rightcol, 0, 1, fg, bg)
  1146.  
  1147.    pnc "Field Name  :                                ", 9, 8, fg, bg
  1148.    pnc "Key (Y/N)   :                                ", 10, 8, fg, bg
  1149.    pnc "Field Format:                                ", 11, 8, fg, bg
  1150.    pnc "Field Length:                                ", 12, 8, fg, bg
  1151.    pnc "Type        :                                ", 13, 8, fg, bg
  1152.    pnc "Case (U/L/A):                                ", 14, 8, fg, bg
  1153.    pnc "Number Dec  :                                ", 15, 8, fg, bg
  1154.    pnc "Row Pos     :                                ", 16, 8, fg, bg
  1155.    pnc "Col Pos     :                                ", 17, 8, fg, bg
  1156.    pnc "Comment     :                                ", 18, 8, fg, bg
  1157.    pnc "Program name:                                ", 19, 8, fg, bg
  1158.  
  1159.    pnc temp.name, 9, 21, fg, bg
  1160.    pnc temp.key, 10, 21, fg, bg
  1161.    pnc temp.format, 11, 21, fg, bg
  1162.    pnc temp.length, 12, 21, fg, bg
  1163.    pnc temp.type, 13, 21, fg, bg
  1164.    pnc temp.case, 14, 21, fg, bg
  1165.    pnc temp.decimal, 15, 21, fg, bg
  1166.    pnc temp.frow, 16, 21, fg, bg
  1167.    pnc temp.fcol, 17, 21, fg, bg
  1168.    pnc temp.comment, 18, 21, fg, bg
  1169.    pnc temp.progname, 19, 21, fg, bg
  1170.  
  1171.   END SUB
  1172.  
  1173. SUB genprogram
  1174.  
  1175.      filespec$ = masterFile$
  1176.      delimit = INSTR(filespec$, ".")
  1177.  
  1178.      IF delimit THEN
  1179.       FileName$ = LEFT$(filespec$, delimit - 1)
  1180.       fileext$ = RIGHT$(filespec$, LEN(filespec$) - (delimit))
  1181.      ELSE
  1182.       FileName$ = filespec$
  1183.       fileext$ = ".BAS"
  1184.      END IF
  1185.  
  1186.      progfile$ = FileName$
  1187.  
  1188.      IF FileExists(progfile$ + ".SCR") THEN
  1189.      'IF FileExists(progfile$ + ".RPT") THEN
  1190.      MsgLine "Creating BASIC program --> " + progfile$ + ".BAS", 25, BLACK, WHITE
  1191.  
  1192.      namelength% = 8
  1193.      Trim progfile$
  1194.  
  1195.      IF FileExists(progfile$ + ".DBF") THEN  'If no index then create
  1196.       KILL progfile$ + ".DBF"
  1197.      END IF
  1198.  
  1199.      IF LEN(progfile$) THEN
  1200.       ff = FREEFILE
  1201.  
  1202.       OPEN "O", ff, progfile$ + ".bas"
  1203.       CALL Trim(tit$)
  1204.  
  1205.       initindex
  1206.  
  1207.       startp = 12 - (numberoffields \ 2)
  1208.  
  1209. '     Findex(Record).num
  1210. '     Findex(Record).Name
  1211. '     Findex(Record).type
  1212. '     Findex(Record).case
  1213. '     Findex(Record).key
  1214. '     Findex(Record).decimal
  1215. '     Findex(Record).length
  1216. '     Findex(Record).format
  1217. '     Findex(Record).frow
  1218. '     Findex(Record).fcol
  1219. '     Findex(Record).comment
  1220. '     Findex(Record).progname
  1221.  
  1222.       CALL PROSRC.1
  1223.  
  1224.       FOR j% = 1 TO numberoffields
  1225.        w$ = Findex(j%).name
  1226.        CALL Trim(w$)
  1227.        IF LEN(w$) THEN
  1228.         IF Findex(j%).type = "I" THEN
  1229.         PRINT #ff, "         " + w$ + " AS  INTEGER"
  1230.         ELSEIF Findex(j%).type = "L" THEN
  1231.         PRINT #ff, "         " + w$ + " AS  LONG"
  1232.         ELSEIF Findex(j%).type = "S" THEN
  1233.         PRINT #ff, "         " + w$ + " AS  SINGLE"
  1234.         ELSEIF Findex(j%).type = "D" THEN
  1235.         PRINT #ff, "         " + w$ + " AS  DOUBLE"
  1236.         ELSEIF Findex(j%).type = "C" THEN
  1237.         PRINT #ff, "         " + w$ + " AS  CURRENCY"
  1238.         ELSE
  1239.         PRINT #ff, "         " + w$ + " AS  STRING * " + Findex(j%).length
  1240.         END IF
  1241.        END IF
  1242.       NEXT j%
  1243.  
  1244.       CALL PROSRC.2
  1245.  
  1246.       PRINT #ff, "  CONST keyindex = 1"
  1247.       PRINT #ff, "  masterfile$ = " + CHR$(34) + progfile$ + ".DBF" + CHR$(34)
  1248.  
  1249.       CY = 1
  1250.  
  1251.       PRINT #ff, ""
  1252.       PRINT #ff, "NEWFILE:"
  1253.       PRINT #ff, ""
  1254.  
  1255. ' CREATE INDEXES HERE
  1256.  
  1257.       PRINT #ff, "   IF FileExists(masterfile$) = 0 THEN  'If no index then create"
  1258.       PRINT #ff, "   OPEN masterfile$ FOR ISAM Recordtype " + CHR$(34) + "database" + CHR$(34) + " AS keyindex  'Open the data file"
  1259.       PRINT #ff, ""
  1260.  
  1261.       CY = 1
  1262.  
  1263.       FOR ntc = 1 TO numberoffields
  1264.        IF Findex(ntc).key = "Y" THEN
  1265.         PRINT #ff, "   Createindex KeyIndex," + CHR$(34) + "Index" + RTRIM$(Findex(ntc).name) + CHR$(34) + ",0," + CHR$(34) + RTRIM$(Findex(ntc).name) + CHR$(34)  'Create INDEX " + Findex(NTC).name
  1266.         CY = CY + 1
  1267.        END IF
  1268.       NEXT ntc
  1269.  
  1270.       PRINT #ff, "   ELSE"
  1271.       PRINT #ff, "   OPEN masterfile$ FOR ISAM Recordtype " + CHR$(34) + "database" + CHR$(34) + " AS keyindex  'Open the data file"
  1272.       PRINT #ff, "   END IF"
  1273.       PRINT #ff, ""
  1274.  
  1275.       CALL PROSRC.3
  1276.  
  1277.       PROSRC.CASE.1
  1278.  
  1279.       PROSRC.CASE.2.1
  1280.  
  1281.       PRINT #ff, ""
  1282.       CY = 1
  1283.  
  1284.       FOR ntc = 1 TO numberoffields
  1285.        IF Findex(ntc).key = "Y" THEN
  1286.  
  1287.         PRINT #ff, "                    sf$(" + STR$(CY) + ") = " + CHR$(34) + LEFT$(Findex(ntc).name, LEN(Findex(ntc).name) - 1) + CHR$(34)
  1288.  
  1289.         CY = CY + 1
  1290.        END IF
  1291.       NEXT ntc
  1292.  
  1293.       IF CY <= 10 THEN
  1294.        dl = CY - 1
  1295.       ELSE
  1296.        dl = 10
  1297.       END IF
  1298.  
  1299.       PRINT #ff, ""
  1300.       PRINT #ff, "                    sf = selbox(sf$()," + STR$(CY - 1) + "," + STR$(dl) + ",16, black, white, RED )"
  1301.       PRINT #ff, "             SELECT CASE SF"
  1302.       PRINT #ff, ""
  1303.  
  1304.       CY = 1
  1305.  
  1306.       FOR ntc = 1 TO numberoffields
  1307.        IF Findex(ntc).key = "Y" THEN
  1308.         PRINT #ff, "             CASE " + STR$(CY)
  1309.         PRINT #ff, "               key$= string$(len(RecField." + RTRIM$(Findex(ntc).name) + ")," + CHR$(34) + " " + CHR$(34) + ")"
  1310.         PRINT #ff, "               setindex KeyIndex, " + CHR$(34) + "Index" + RTRIM$(Findex(ntc).name) + CHR$(34)
  1311.         PRINT #ff, "                nameofindex$ = " + CHR$(34) + "Index" + RTRIM$(Findex(ntc).name) + CHR$(34)
  1312.         CY = CY + 1
  1313.        END IF
  1314.       NEXT ntc
  1315.  
  1316.       PRINT #ff, "            END SELECT"
  1317.       PRINT #ff, ""
  1318.  
  1319.       PROSRC.CASE.2.2
  1320.       PROSRC.CASE.3.1
  1321.  
  1322.       CY = 1
  1323.  
  1324.       FOR ntc = 1 TO numberoffields
  1325.        IF Findex(ntc).key = "Y" THEN
  1326.  
  1327.         PRINT #ff, "                    sf$(" + STR$(CY) + ") = " + CHR$(34) + LEFT$(Findex(ntc).name, LEN(Findex(ntc).name) - 1) + CHR$(34)
  1328.         PRINT #ff, "                    captal sf$(" + STR$(CY) + ")"
  1329.  
  1330.         CY = CY + 1
  1331.        END IF
  1332.       NEXT ntc
  1333.  
  1334.       IF CY <= 10 THEN
  1335.        dl = CY - 1
  1336.       ELSE
  1337.        dl = 10
  1338.       END IF
  1339.       PRINT #ff, ""
  1340.       PRINT #ff, "                    sf = selbox(sf$()," + STR$(CY - 1) + "," + STR$(dl) + ",16, black, white, RED )"
  1341.       PRINT #ff, ""
  1342.       PRINT #ff, "             SELECT CASE SF"
  1343.  
  1344.       CY = 1
  1345.  
  1346.       FOR ntc = 1 TO numberoffields
  1347.        IF Findex(ntc).key = "Y" THEN
  1348.         PRINT #ff, "             CASE " + STR$(CY)
  1349.         PRINT #ff, "               key$= string$(len(RecField." + RTRIM$(Findex(ntc).name) + ")," + CHR$(34) + " " + CHR$(34) + ")"
  1350.         PRINT #ff, "               setindex KeyIndex, " + CHR$(34) + "Index" + RTRIM$(Findex(ntc).name) + CHR$(34)
  1351.         PRINT #ff, "                nameofindex$ = " + CHR$(34) + "Index" + RTRIM$(Findex(ntc).name) + CHR$(34)
  1352.         CY = CY + 1
  1353.        END IF
  1354.       NEXT ntc
  1355.  
  1356.       PRINT #ff, "            END SELECT"
  1357.  
  1358.       PRINT #ff, ""
  1359.  
  1360.       PROSRC.CASE.3.3
  1361.  
  1362.       FOR j% = 1 TO numberoffields
  1363.  
  1364.        w$ = Findex(j%).name
  1365.        F$ = Findex(j%).format
  1366.        T$ = Findex(j%).type
  1367.        d$ = w$ + ":"
  1368.  
  1369.        CALL Trim(w$)
  1370.        CALL Trim(F$)
  1371.        CALL Trim(T$)
  1372.  
  1373.        IF LEN(w$) THEN
  1374.         IF j% = 1 THEN
  1375.  
  1376.          SELECT CASE T$
  1377.          CASE "N"
  1378.           PRINT #ff, "                lp$ =  userNformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1379.          CASE "I", "L", "S", "D", "C"
  1380.           PRINT #ff, "                lp$ =  userNformat((RTRIM$(STR$(RecField." + w$ + ")))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1381.          CASE ELSE
  1382.           PRINT #ff, "                lp$ =  userSformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1383.           END SELECT
  1384.  
  1385.         ELSE
  1386.  
  1387.          SELECT CASE T$
  1388.          CASE "N"
  1389.           PRINT #ff, "                lp$ = lp$ + userNformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1390.          CASE "I", "L", "S", "D", "C"
  1391.           PRINT #ff, "                lp$ = lp$ + userNformat((RTRIM$(STR$(RecField." + w$ + ")))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1392.          CASE ELSE
  1393.           PRINT #ff, "                lp$ = lp$ + userSformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1394.           END SELECT
  1395.         END IF
  1396.        END IF
  1397.  
  1398.       NEXT j%
  1399.  
  1400.       PROSRC.CASE.3.4
  1401.  
  1402.       FOR j% = 1 TO numberoffields
  1403.  
  1404.        w$ = Findex(j%).name
  1405.        F$ = Findex(j%).format
  1406.        T$ = Findex(j%).type
  1407.        d$ = w$ + ":"
  1408.  
  1409.        CALL Trim(w$)
  1410.        CALL Trim(F$)
  1411.        CALL Trim(T$)
  1412.  
  1413.        IF LEN(w$) THEN
  1414.         IF j% = 1 THEN
  1415.  
  1416.          SELECT CASE T$
  1417.          CASE "N"
  1418.           PRINT #ff, "                lp$ =  userNformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1419.          CASE "I", "L", "S", "D", "C"
  1420.           PRINT #ff, "                lp$ =  userNformat((RTRIM$(STR$(RecField." + w$ + ")))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1421.          CASE ELSE
  1422.           PRINT #ff, "                lp$ =  userSformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1423.           END SELECT
  1424.  
  1425.         ELSE
  1426.  
  1427.          SELECT CASE T$
  1428.          CASE "N"
  1429.           PRINT #ff, "                lp$ = lp$ + userNformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1430.          CASE "I", "L", "S", "D", "C"
  1431.           PRINT #ff, "                lp$ = lp$ + userNformat((RTRIM$(STR$(RecField." + w$ + ")))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1432.          CASE ELSE
  1433.           PRINT #ff, "                lp$ = lp$ + userSformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1434.           END SELECT
  1435.  
  1436.         END IF
  1437.        END IF
  1438.  
  1439.       NEXT j%
  1440.  
  1441.       PROSRC.CASE.3.5
  1442.       PROSRC.CASE.4.1
  1443.  
  1444.       PRINT #ff, "                    MsgLine " + CHR$(34) + "Press  " + CHR$(24) + " for last " + CHR$(25) + " for next  ENTER to select" + CHR$(34) + ",25 , 0, 7"
  1445.       PRINT #ff, "                    DrawBox 21, 22, 40, 3, 2, black, white, 1, black, white, 1"
  1446.       PRINT #ff, "                    CenterText " + CHR$(34) + "Select RecField Database" + CHR$(34) + ", 22, black, white"
  1447.       PRINT #ff, ""
  1448.  
  1449.       CY = 1
  1450.  
  1451.       FOR ntc = 1 TO numberoffields
  1452.        IF Findex(ntc).key = "Y" THEN
  1453.  
  1454.         PRINT #ff, "                    sf$(" + STR$(CY) + ") = " + CHR$(34) + LEFT$(Findex(ntc).name, LEN(Findex(ntc).name) - 1) + CHR$(34)
  1455.  
  1456.         CY = CY + 1
  1457.        END IF
  1458.       NEXT ntc
  1459.  
  1460.       IF CY <= 10 THEN
  1461.        dl = CY - 1
  1462.       ELSE
  1463.        dl = 10
  1464.       END IF
  1465.       PRINT #ff, ""
  1466.       PRINT #ff, "             sf = selbox(sf$()," + STR$(CY - 1) + "," + STR$(dl) + ",16, black, white, RED )"
  1467.       PRINT #ff, ""
  1468.       PRINT #ff, "             SELECT CASE SF"
  1469.  
  1470.       CY = 1
  1471.  
  1472.       FOR ntc = 1 TO numberoffields
  1473.        IF Findex(ntc).key = "Y" THEN
  1474.         PRINT #ff, "             CASE " + STR$(CY)
  1475.         PRINT #ff, "               key$= string$(len(RecField." + RTRIM$(Findex(ntc).name) + ")," + CHR$(34) + " " + CHR$(34) + ")"
  1476.         PRINT #ff, "               setindex KeyIndex, " + CHR$(34) + "Index" + RTRIM$(Findex(ntc).name) + CHR$(34)
  1477.         PRINT #ff, "                nameofindex$ = " + CHR$(34) + "Index" + RTRIM$(Findex(ntc).name) + CHR$(34)
  1478.         CY = CY + 1
  1479.        END IF
  1480.       NEXT ntc
  1481.  
  1482.       PRINT #ff, ""
  1483.       PRINT #ff, "            END SELECT"
  1484.       PROSRC.CASE.4.2
  1485.  
  1486.       PRINT #ff, ""
  1487.  
  1488.       PROSRC.CASE.5.0
  1489.       PROSRC.CASE.6
  1490.       PROSRC.CASE.7.1
  1491.       PROSRC.CASE.7.2
  1492.  
  1493.       FOR sc = 1 TO numberoffields
  1494.  
  1495.        SELECT CASE sc
  1496.         CASE 1
  1497.          PRINT #ff, "getfieldinfo:  ' prints screens and gets record info"
  1498.          PRINT #ff, ""
  1499.          PRINT #ff, "   op = 1"
  1500.          PRINT #ff, ""
  1501.          PRINT #ff, "   DO ' loop until page down or esc key"
  1502.          PRINT #ff, ""
  1503.          PRINT #ff, "         pnc " + CHR$(34) + "ESC to exit PgDn TO update, " + CHR$(24) + " for prev " + CHR$(25) + " for next F1 edit help" + CHR$(34) + ", 25, 10, 0, 7 "
  1504.          PRINT #ff, ""
  1505.          PRINT #ff, "      SELECT CASE OP"
  1506.        END SELECT
  1507.  
  1508.        PRINT #ff, ""
  1509.        PRINT #ff, "              CASE" + STR$(sc) + "  '" + Findex(sc).comment
  1510.  
  1511.        SELECT CASE sc
  1512.  
  1513.         CASE 1, 19, 37, 55, 73, 91, 109, 127, 145, 163, 181, 199, 217, 235, 253
  1514.  
  1515.          PRINT #ff, ""
  1516.          PRINT #ff, "              CALL " + progfile$ + ".scn" + LTRIM$(STR$((sc \ 18) + 1))
  1517.          PRINT #ff, "              CALL " + progfile$ + ".info" + LTRIM$(STR$((sc \ 18) + 1))
  1518.  
  1519.        END SELECT
  1520.  
  1521.        PRINT #ff, ""
  1522.        PRINT #ff, "              LOCATE " + Findex(sc).frow + "," + Findex(sc).fcol
  1523.  
  1524.        fm$ = Findex(sc).format
  1525.        Trim fm$
  1526.  
  1527.        PRINT #ff, "              format$ = " + CHR$(34) + fm$ + CHR$(34)
  1528.  
  1529.        SELECT CASE Findex(sc).case
  1530.         CASE "U"
  1531.          selcase = 1
  1532.         CASE "L"
  1533.          selcase = 2
  1534.         CASE ELSE
  1535.          selcase = 0
  1536.        END SELECT
  1537.  
  1538.        SELECT CASE Findex(sc).type
  1539.  
  1540.        CASE "I", "L", "S", "D", "C"
  1541.  
  1542.        PRINT #ff, "              edit$ = str$(RecField." + RTRIM$(Findex(sc).name) + ")"
  1543.        PRINT #ff, "              Trim edit$"
  1544.        PRINT #ff, "              edit$ = FEN(0, WHITE, BLACK, edit$, format$, Ek, 0, 1, 1, 1, 1, 1, 0)"
  1545.        PRINT #ff, "              Trim edit$"
  1546.        PRINT #ff, "              RecField." + RTRIM$(Findex(sc).name) + "= VAL(edit$)"
  1547.  
  1548.        CASE "N"
  1549.  
  1550.        PRINT #ff, "              edit$ = RecField." + RTRIM$(Findex(sc).name)
  1551.        PRINT #ff, "              Trim edit$"
  1552.        PRINT #ff, "              edit$ = FEN(0, WHITE, BLACK, edit$, format$, Ek, 0, 1, 1, 1, 1, 1, 0)"
  1553.        PRINT #ff, "              RecField." + RTRIM$(Findex(sc).name) + "= edit$"
  1554.  
  1555.        CASE ELSE
  1556.  
  1557.        PRINT #ff, "              edit$ = RecField." + RTRIM$(Findex(sc).name)
  1558.        PRINT #ff, "              Trim edit$"
  1559.        PRINT #ff, "              edit$ = FES(0, WHITE, BLACK, edit$, format$," + STR$(selcase) + ", Ek, 1, 0, 1, 1, 1, 0, 1, 0)"
  1560.        PRINT #ff, "              RecField." + RTRIM$(Findex(sc).name) + "= edit$"
  1561.        END SELECT
  1562.        PRINT #ff, ""
  1563.        PRINT #ff, "              SELECT CASE Ek   ' get exit key"
  1564.        PRINT #ff, "                     CASE 1"
  1565.        PRINT #ff, "                     op = op - 1 ' goto previous field"
  1566.        PRINT #ff, "                     CASE 5"
  1567.        PRINT #ff, "                     op = op + 1 ' goto next field"
  1568.        PRINT #ff, "                     CASE 3"
  1569.        PRINT #ff, "                     op = op + 1"
  1570.        PRINT #ff, "                     CASE 4"
  1571.        PRINT #ff, "                     op = " + STR$(numberoffields + 1) + "  'page down so update"
  1572.        PRINT #ff, "                     CASE 7"
  1573.        PRINT #ff, "                     op = 999 'ESC key so exit"
  1574.        PRINT #ff, "              END SELECT"
  1575.  
  1576.       NEXT sc
  1577.  
  1578.       PRINT #ff, ""
  1579.       PRINT #ff, "              CASE " + STR$(numberoffields + 1) + "  'END REACHED"
  1580.       PRINT #ff, ""
  1581.       PRINT #ff, "              SELECT CASE mopt  'do option"
  1582.       PRINT #ff, ""
  1583.       PRINT #ff, "         'INSERT or Change record key"
  1584.       PRINT #ff, ""
  1585.       PRINT #ff, "              CASE 1  'INSERT"
  1586.       PRINT #ff, ""
  1587.       PRINT #ff, "                  INSERT keyindex, RecField"
  1588.       PRINT #ff, "                  CHECKPOINT"
  1589.       PRINT #ff, "                  EXIT DO  'INSERTED!"
  1590.       PRINT #ff, ""
  1591.       PRINT #ff, "              CASE 2  'Edit, Update"
  1592.       PRINT #ff, ""
  1593.       PRINT #ff, "                  UPDATE keyindex, RecField"
  1594.       PRINT #ff, "                  CHECKPOINT ' update isam record"
  1595.       PRINT #ff, "                  EXIT DO"
  1596.       PRINT #ff, "          CASE ELSE"
  1597.       PRINT #ff, "  END SELECT"
  1598.       PRINT #ff, ""
  1599.       PRINT #ff, "  CASE 999"
  1600.       PRINT #ff, "  EXIT DO"
  1601.       PRINT #ff, "  CASE ELSE"
  1602.       PRINT #ff, "   END"
  1603.       PRINT #ff, "  END SELECT"
  1604.       PRINT #ff, "  LOOP"
  1605.       PRINT #ff, "  RETURN"
  1606.       PRINT #ff, ""
  1607.       PRINT #ff, "InitRecField:"
  1608.  
  1609.       CY = 1
  1610.  
  1611.       FOR ntc = 1 TO numberoffields
  1612.        T$ = Findex(ntc).type
  1613.        CALL Trim(T$)
  1614.          SELECT CASE T$
  1615.          CASE "I", "L", "S", "D", "C"
  1616.          PRINT #ff, "       RecField." + RTRIM$(Findex(ntc).name) + " = 0"
  1617.          CASE ELSE
  1618.          PRINT #ff, "       RecField." + RTRIM$(Findex(ntc).name) + " = " + CHR$(34) + CHR$(34)
  1619.          END SELECT
  1620.          CY = CY + 1
  1621.       NEXT ntc
  1622.  
  1623.       PRINT #ff, "RETURN"
  1624.  
  1625.       FOR NS = 1 TO (numberoffields \ 18) + 1
  1626.  
  1627.        PROSRC.SCN.1 NS, progfile$
  1628. ' screen
  1629.        ffs = FREEFILE
  1630.        OPEN "r", ffs, progfile$ + ".SCR", 80
  1631.        FIELD #ffs, 80 AS s1$
  1632.        FOR j% = 1 TO 24
  1633.         GET #ffs, j%
  1634.         scrnline$(j%) = s1$
  1635.        NEXT j%
  1636.        CLOSE ffs
  1637.  
  1638.        initindex
  1639.  
  1640.        FOR j% = 1 TO 24
  1641.         w$ = scrnline$(j%)
  1642.         CALL Trim(w$)
  1643.  
  1644.         IF LEN(w$) THEN
  1645.          w% = INSTR(scrnline$(j%), w$)
  1646.          PRINT #ff, "        pnc " + CHR$(34) + w$ + CHR$(34) + "," + strval$(j%) + "," + strval$(w%) + ",fg,bg"
  1647.         END IF
  1648.        NEXT j%
  1649.  
  1650.        PRINT #ff, "  end sub ' " + progfile$
  1651.        PROSRC.INFO.1 NS, progfile$
  1652.  
  1653.        FOR j% = 1 TO numberoffields
  1654.  
  1655.         w$ = Findex(j%).name
  1656.         F$ = Findex(j%).format
  1657.         T$ = Findex(j%).type
  1658.         d$ = w$ + ":"
  1659.  
  1660.         CALL Trim(w$)
  1661.         CALL Trim(F$)
  1662.         CALL Trim(T$)
  1663.  
  1664.         IF LEN(w$) THEN
  1665.  
  1666.          PRINT #ff, "        fg = black"  '    PNC " + CHR$(34) + d$ + CHR$(34) + "," + LTRIM$(STR$(j%)) + " + startp ,17,fg,bg"
  1667.          PRINT #ff, "        bg = white"
  1668.          SELECT CASE T$
  1669.          CASE "N"
  1670.           PRINT #ff, "        PNC userNformat ((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ")," + Findex(j%).frow + "," + Findex(j%).fcol + ", fg, bg"
  1671.          CASE "I", "L", "S", "D", "C"
  1672.           PRINT #ff, "        PNC userNformat ((RTRIM$(STR$(RecField." + w$ + ")))," + CHR$(34) + F$ + CHR$(34) + ")," + Findex(j%).frow + "," + Findex(j%).fcol + ", fg, bg"
  1673.          CASE ELSE
  1674.           PRINT #ff, "        PNC userSformat ((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ")," + Findex(j%).frow + "," + Findex(j%).fcol + ", fg, bg"
  1675.          END SELECT
  1676.         END IF
  1677.        NEXT j%
  1678.  
  1679.        PRINT #ff, "  end sub ' " + progfile$
  1680.       NEXT NS
  1681.  
  1682.       CALL PROSRC.9
  1683.       CALL PROBRO.1
  1684.  
  1685.       PRINT #ff, "getreinfo:          'add if more than key RecField is displayed"
  1686.       PRINT #ff, ""
  1687.       PRINT #ff, "      RETRIEVE indexnum, RecField"
  1688.  
  1689.       FOR j% = 1 TO numberoffields
  1690.  
  1691.        w$ = Findex(j%).name
  1692.        F$ = Findex(j%).format
  1693.        T$ = Findex(j%).type
  1694.        d$ = w$ + ":"
  1695.  
  1696.        CALL Trim(w$)
  1697.        CALL Trim(F$)
  1698.        CALL Trim(T$)
  1699.  
  1700.        IF LEN(w$) THEN
  1701.         IF j% = 1 THEN
  1702.          SELECT CASE T$
  1703.          CASE "N"
  1704.           PRINT #ff, "               dl$ =  userNformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1705.          CASE "I", "L", "S", "D", "C"
  1706.           PRINT #ff, "               dl$ =  userNformat((RTRIM$(STR$(RecField." + w$ + ")))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1707.          CASE ELSE
  1708.           PRINT #ff, "               dl$ =  userSformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1709.          END SELECT
  1710.         ELSE
  1711.          SELECT CASE T$
  1712.          CASE "N"
  1713.           PRINT #ff, "               dl$ = dl$ + userNformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1714.          CASE "I", "L", "S", "D", "C"
  1715.           PRINT #ff, "               dl$ = dl$ + userNformat((RTRIM$(STR$(RecField." + w$ + ")))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1716.          CASE ELSE
  1717.           PRINT #ff, "               dl$ = dl$ + userSformat((RTRIM$(RecField." + w$ + "))," + CHR$(34) + F$ + CHR$(34) + ") + " + CHR$(34) + " " + CHR$(34)
  1718.          END SELECT
  1719.         END IF
  1720. 'END IF
  1721.        END IF
  1722.  
  1723.       NEXT j%
  1724.  
  1725.       PRINT #ff, "               DispLine$ = LEFT$(Dl$,70)"
  1726.       PRINT #ff, ""
  1727.       PRINT #ff, "      RETURN"
  1728.       PRINT #ff, "   END SUB"
  1729.  
  1730.       CLOSE ff
  1731.  
  1732.       MsgLine "Creating BAT file --> CREATE.BAT", 12, BLACK, WHITE
  1733.  
  1734.       ff = FREEFILE
  1735.       Trim progfile$
  1736.  
  1737.       OPEN "O", ff, "CREATE.BAT"
  1738.       PRINT #ff, "REM compile and link " + progfile$ + ".BAS"
  1739.       PRINT #ff, "BC /O/X/FS " + progfile$ + ".bas;"
  1740.       PRINT #ff, "LINK /EX " + progfile$ + "," + progfile$ + ".exe,, prolib71.lib;"
  1741.       PRINT #ff, "ERASE " + progfile$ + ".obj"
  1742.  
  1743.       CLOSE ff
  1744.  
  1745.       MsgLine "Creating BAT file --> EDIT.BAT", 12, BLACK, WHITE
  1746.  
  1747.       ff = FREEFILE
  1748.       Trim progfile$
  1749.  
  1750.       OPEN "O", ff, "EDIT.BAT"
  1751.       PRINT #ff, "REM editing " + progfile$ + ".BAS"
  1752.       PRINT #ff, "QBX " + progfile$ + " /Lprolib71"
  1753.       CLOSE ff
  1754.      END IF
  1755.      'ELSE
  1756.      'noreport
  1757.      'END IF
  1758.     ELSE
  1759.     noscreen
  1760.     END IF
  1761.  
  1762. END SUB
  1763.  
  1764.   SUB initindex STATIC
  1765.  
  1766.    DIM TempField AS RecordType
  1767.  
  1768.    FOR j% = 1 TO 24
  1769.     FOR k% = 1 TO 80
  1770.      fieldpointer%(j%, k%) = 0
  1771.     NEXT k%
  1772.    NEXT j%
  1773.  
  1774.    LastREC = LOF(datfile) \ LEN(TempField)
  1775.  
  1776.    numberoffields = 0
  1777.    FOR record = 1 TO LastREC
  1778.  
  1779. ' Read a record from the file and put each field in the array.
  1780.  
  1781.     GET #datfile, record, TempField
  1782.  
  1783.  
  1784.     IF TempField.status = "U" THEN
  1785.  
  1786.      Findex(record).status = TempField.status
  1787.      Findex(record).Num = TempField.Num
  1788.      Findex(record).name = TempField.name
  1789.      Findex(record).type = TempField.type
  1790.      Findex(record).case = TempField.case
  1791.      Findex(record).key = TempField.key
  1792.      Findex(record).decimal = TempField.decimal
  1793.      Findex(record).length = TempField.length
  1794.      Findex(record).format = TempField.format
  1795.      Findex(record).frow = TempField.frow
  1796.      Findex(record).fcol = TempField.fcol
  1797.      Findex(record).comment = TempField.comment
  1798.      Findex(record).progname = TempField.progname
  1799.      Findex(record).recnum = record
  1800.  
  1801.      fl$ = TempField.format
  1802.      Trim fl$
  1803.      FOR fieldREC% = VAL(TempField.fcol) TO VAL(TempField.fcol) + LEN(fl$) - 1
  1804.       fieldpointer%(VAL(TempField.frow), fieldREC%) = record
  1805.      NEXT
  1806.  
  1807.      numberoffields = numberoffields + 1
  1808.  
  1809.     END IF
  1810.  
  1811.    NEXT record
  1812.  
  1813.   END SUB
  1814.  
  1815. '
  1816.   SUB RecFieldselect (indexnum, key$, MastRec, IndexRec, exitcode) STATIC
  1817.  
  1818.    fg = WHITE
  1819.    bg = BLUE
  1820.  
  1821.    REDIM dg$(5)
  1822.    REDIM TempMasREC(10)
  1823.    REDIM TempIdxREC(10)
  1824.  
  1825.    CONST CORRUPT = "Error: PIM Index Corrupt"
  1826.    CONST EX$ = " ESC = Exit  ENTER = Select  ? = Key search "  '  F1 = Options "
  1827.  
  1828. 'define select option window
  1829.  
  1830.    row = 6
  1831.    col = 3
  1832.    lin = 10
  1833.    numofsel = 0
  1834.  
  1835.    exitcode = 0  'What's selected
  1836.    bodertype = 2  'Border typeincode
  1837.  
  1838.    Nf = BLACK  'Normal Foreground
  1839.    Nb = WHITE  'Normal Background
  1840.    sf = WHITE + 8  'Select Foreground
  1841.    SB = BLACK  'Select Background
  1842.    ff = YELLOW  'Frame Foreground
  1843.    Fb = BLACK  'Frame Background
  1844.  
  1845. 'end of select option's
  1846.  
  1847.    MsgLine EX$, 25, 0, 7
  1848.  
  1849. restart:
  1850.  
  1851.    IF PIMstats(indexnum) = 0 THEN  'No keys in the index
  1852.     curmasrec = 0
  1853.     IndexRec = 0
  1854.     exitcode = 0  'code No keys in the Index
  1855.     EXIT SUB
  1856.    END IF
  1857.  
  1858.    KeyLen = 20
  1859.    skey$ = "FIELD NAME"
  1860.    dg$(1) = "Enter FIELD NAME"
  1861.    dg$(2) = "An exact match is not needed."
  1862.  
  1863.    height = lin
  1864.    startpos = height
  1865.    col = 80 / 2 - KeyLen / 2
  1866.    dwidth = KeyLen  'Maximum(KeyLen, LEN(Ex$))
  1867.  
  1868.    Trim dg$(1)
  1869.    Trim dg$(2)
  1870.  
  1871.    Dwidth2 = dwidth
  1872.    dwidth = dwidth + 4
  1873.  
  1874.    totalheight = height + 2  'Scroll box height (plus borders)
  1875.    totalheight = totalheight + 2  'Quit Box + ESC + lineNum
  1876.    checkheight = totalheight + row - 1  'Check the complete height
  1877.  
  1878.    IF checkheight > MAXROW THEN
  1879.     curmasrec = 0
  1880.     IndexRec = 0
  1881.     EXIT SUB
  1882.    END IF
  1883.  
  1884.    CheckWidth = dwidth + col - 1
  1885.  
  1886.    IF CheckWidth > 80 THEN
  1887.     curmasrec = 0
  1888.     IndexRec = 0
  1889.     EXIT SUB
  1890.    END IF
  1891. 'Save Screen
  1892.  
  1893.    GetBackground row, col, row + totalheight + 2, col + dwidth + 1, buf$
  1894.    DrawBox row, col, dwidth, totalheight, bodertype, ff, Fb, 1, Nf, Nb, 0
  1895.  
  1896.    Crow = row + height + 1
  1897.    Ccol = col + 2
  1898.    Acc$ = STRING$(dwidth - 2, 196)
  1899.  
  1900.    pnc Acc$, Crow, Ccol - 1, ff, Fb
  1901.  
  1902.    Crow = row + height + 2
  1903.    kcol = Ccol + KeyLen / 2 - LEN(skey$) / 2
  1904.  
  1905.    pnc skey$, Crow, kcol, ff, Fb
  1906.  
  1907.    GOSUB homeCkeys  'Display from the top
  1908.    GOSUB DisplayCkeys  'Display the Ckeys
  1909.    CurrentROW = 1  'Current Row
  1910.  
  1911.    DO  'Loop
  1912.     Acc$ = DispLine$(CurrentROW)
  1913.  
  1914.     IF LEN(Acc$) < Dwidth2 - 2 THEN
  1915.      Acc$ = Acc$ + STRING$(Dwidth2 - LEN(Acc$), 32)
  1916.     END IF
  1917.  
  1918.     Crow = CurrentROW + row
  1919.     pnc Acc$, Crow, Ccol, sf, SB
  1920.  
  1921.     kbd$ = ""
  1922.  
  1923.     WHILE kbd$ = ""
  1924.      kbd$ = INKEY$
  1925.     WEND
  1926.  
  1927.     IF LEN(kbd$) = 1 THEN
  1928.      useroption = ASC(RIGHT$(kbd$, 1))
  1929.  
  1930.      SELECT CASE useroption
  1931.  
  1932.       CASE 63  '? search key
  1933.  
  1934.        DialogBox dg$(), 1, 1, 20, ff, Fb, Nf, Nb, 1, ans$, "", Exk
  1935.  
  1936.        key$ = ans$
  1937. 'IndexFind
  1938.        PIM "S", indexnum, key$, MastRec, IndexRec
  1939.  
  1940.        IF IndexRec THEN
  1941.         GOSUB getrecinfo
  1942.         DispLine$(1) = DispLine$
  1943.         TempMasREC(1) = ABS(MastRec)
  1944.         TempIdxREC(1) = IndexRec
  1945.  
  1946.        ELSE
  1947.         PRINT CORRUPT
  1948.         END
  1949.        END IF
  1950.  
  1951.        PrevMastRec = MastRec
  1952.        PrevIndexRec = IndexRec
  1953.  
  1954.        GOSUB GetNextCten
  1955.        CurrentROW = 1
  1956.        GOSUB DisplayCkeys
  1957.  
  1958.       CASE 48 TO 57, 65 TO 90, 97 TO 122  'first letter search
  1959. 'IndexFind
  1960.        key$ = UCASE$(CHR$(useroption))
  1961.  
  1962.        PIM "S", indexnum, key$, MastRec, IndexRec
  1963.  
  1964.        IF IndexRec THEN
  1965.         GOSUB getrecinfo
  1966.         DispLine$(1) = DispLine$
  1967.         TempMasREC(1) = ABS(MastRec)
  1968.         TempIdxREC(1) = IndexRec
  1969.  
  1970.        ELSE
  1971.         PRINT CORRUPT
  1972.         END
  1973.        END IF
  1974.  
  1975.        PrevMastRec = MastRec
  1976.        PrevIndexRec = IndexRec
  1977.  
  1978.        GOSUB GetNextCten
  1979.        CurrentROW = 1
  1980.        GOSUB DisplayCkeys
  1981.  
  1982.       CASE 27  'ESCAPE
  1983.        key$ = ""
  1984.        MastRec = 0
  1985.        IndexRec = 0
  1986.        exitcode = 1  ' ESC
  1987.        EXIT DO
  1988.  
  1989.       CASE 13  'RETURN
  1990.        key$ = DispLine$(CurrentROW)
  1991.        MastRec = TempMasREC(CurrentROW)
  1992.        IndexRec = TempIdxREC(CurrentROW)
  1993.        exitcode = 2  ' RETURN
  1994.        EXIT DO
  1995.  
  1996.       CASE ELSE
  1997.      END SELECT
  1998.  
  1999.     END IF
  2000.  
  2001.     IF LEN(kbd$) = 2 THEN
  2002.      useroption = ASC(RIGHT$(kbd$, 1))
  2003.  
  2004.      SELECT CASE useroption
  2005.  
  2006.       CASE 59
  2007.  
  2008.        Fkey = useroption - 58
  2009.        IF numofsel >= Fkey THEN
  2010.         exitcode = Fkey
  2011.         key$ = DispLine$(CurrentROW)
  2012.         MastRec = TempMasREC(CurrentROW)
  2013.         IndexRec = TempIdxREC(CurrentROW)
  2014.  
  2015.         menu$ = "1 - Search by NAME\"
  2016.         menu$ = menu$ + "2 - Search by length\"
  2017.  
  2018.         indexnum = MenuWindow(0, 0, menu$, "Search option", BLACK, WHITE, RED, 0)
  2019.  
  2020.         PutBackground row, col, buf$
  2021.         buf$ = ""
  2022.         MsgLine EX$, 25, 0, 7
  2023.  
  2024.         GOTO restart
  2025.        END IF
  2026.  
  2027.       CASE 71  'Home
  2028.        CurrentROW = 1
  2029.        GOSUB homeCkeys
  2030.        GOSUB DisplayCkeys
  2031.  
  2032.       CASE 81  'pg Down
  2033.        CurrentROW = 1
  2034.        FOR lineNum = 1 TO height
  2035.         TempMasREC(lineNum) = 0
  2036.         TempIdxREC(lineNum) = 0
  2037.         PrevMastRec = 0
  2038.         DispLine$(lineNum) = STRING$(KeyLen, 32)
  2039.        NEXT lineNum
  2040.  
  2041.        PIM "N", indexnum, key$, MastRec, IndexRec
  2042.  
  2043.        IF IndexRec THEN
  2044.         GOSUB getrecinfo
  2045.         DispLine$(1) = DispLine$
  2046.         TempMasREC(1) = MastRec
  2047.         TempIdxREC(1) = IndexRec
  2048.  
  2049.        ELSE
  2050.         PRINT CORRUPT
  2051.         END
  2052.        END IF
  2053.  
  2054.        PrevMastRec = MastRec
  2055.        PrevIndexRec = IndexRec
  2056.  
  2057.        GOSUB GetNextCten
  2058.        GOSUB DisplayCkeys
  2059.  
  2060.       CASE 73  'pg Up
  2061.        CurrentROW = 1
  2062.        GOSUB GetLastCpage
  2063.        GOSUB DisplayCkeys
  2064.  
  2065.       CASE 79  'End
  2066.        IF startpos >= height THEN
  2067.         CurrentROW = 1
  2068.         GOSUB endCkeys
  2069.         GOSUB DisplayCkeys
  2070.        END IF
  2071.       CASE 80  'Down Arrow
  2072.        CurrentROW = CurrentROW + 1
  2073.        IF CurrentROW > height THEN
  2074.         CurrentROW = CurrentROW - 1
  2075.  
  2076.         IF TempIdxREC(height) <> 0 THEN
  2077.          key$ = DispLine$(height)
  2078.          MastRec = TempMasREC(height)
  2079.          IndexRec = TempIdxREC(height)
  2080.          PrevIndexRec = IndexRec
  2081. 'IndexNext
  2082.          PIM "N", indexnum, key$, MastRec, IndexRec
  2083.  
  2084.          IF IndexRec <> 0 THEN
  2085.           IF PrevIndexRec <> IndexRec THEN
  2086.            FOR lineNum = 1 TO height - 1
  2087.             TempIdxREC(lineNum) = TempIdxREC(lineNum + 1)
  2088.             TempMasREC(lineNum) = TempMasREC(lineNum + 1)
  2089.             DispLine$(lineNum) = DispLine$(lineNum + 1)
  2090.            NEXT lineNum
  2091.            GOSUB getrecinfo
  2092.            DispLine$(height) = DispLine$
  2093.            TempMasREC(height) = MastRec
  2094.            TempIdxREC(height) = IndexRec
  2095.           END IF
  2096.          END IF
  2097.         END IF
  2098.        ELSE
  2099.         IF TempIdxREC(CurrentROW) = 0 THEN
  2100.          CurrentROW = CurrentROW - 1
  2101.         END IF
  2102.        END IF
  2103.        GOSUB DisplayCkeys
  2104.  
  2105.       CASE 72  'Up Arrow
  2106.        CurrentROW = CurrentROW - 1
  2107.        IF CurrentROW < 1 THEN
  2108.         CurrentROW = CurrentROW + 1
  2109.  
  2110.         IF TempIdxREC(1) <> 0 THEN
  2111.          key$ = DispLine$(1)
  2112.          MastRec = TempMasREC(1)
  2113.          IndexRec = TempIdxREC(1)
  2114.          PrevIndexRec = IndexRec
  2115. 'IndexPrevious
  2116.          PIM "P", indexnum, key$, MastRec, IndexRec
  2117.  
  2118.          IF IndexRec <> 0 THEN
  2119.           IF PrevIndexRec <> IndexRec THEN
  2120.            FOR lineNum = height TO 2 STEP -1
  2121.             TempIdxREC(lineNum) = TempIdxREC(lineNum - 1)
  2122.             TempMasREC(lineNum) = TempMasREC(lineNum - 1)
  2123.             DispLine$(lineNum) = DispLine$(lineNum - 1)
  2124.            NEXT lineNum
  2125.            GOSUB getrecinfo
  2126.            DispLine$(1) = DispLine$
  2127.            TempMasREC(1) = MastRec
  2128.            TempIdxREC(1) = IndexRec
  2129.           END IF
  2130.          END IF
  2131.         END IF
  2132.        ELSE
  2133.         IF TempIdxREC(CurrentROW) = 0 THEN
  2134.          CurrentROW = CurrentROW + 1
  2135.         END IF
  2136.        END IF
  2137.        GOSUB DisplayCkeys
  2138.  
  2139.       CASE ELSE
  2140.      END SELECT
  2141.     END IF
  2142.    LOOP
  2143.  
  2144. 'Restore Screen
  2145.  
  2146.    PutBackground row, col, buf$
  2147.    buf$ = ""
  2148.    EXIT SUB
  2149.  
  2150. DisplayCkeys:
  2151.  
  2152.    FOR lineNum = 1 TO height
  2153.     Acc$ = DispLine$(lineNum)
  2154.     IF LEN(Acc$) < Dwidth2 THEN
  2155.      Acc$ = Acc$ + STRING$(Dwidth2 - LEN(Acc$), 32)
  2156.     END IF
  2157.     Crow = row + lineNum
  2158.     pnc Acc$, Crow, Ccol, Nf, Nb
  2159.    NEXT lineNum
  2160.    startpos = lineNum
  2161.    RETURN
  2162.  
  2163. homeCkeys:
  2164.  
  2165.    FOR lineNum = 1 TO height
  2166.     TempMasREC(lineNum) = 0
  2167.     TempIdxREC(lineNum) = 0
  2168.     PrevMastRec = 0
  2169.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2170.    NEXT lineNum
  2171.  
  2172.    PIM "F", indexnum, key$, MastRec, IndexRec
  2173.  
  2174.    IF IndexRec THEN
  2175.  
  2176.     GOSUB getrecinfo
  2177.     DispLine$(1) = DispLine$
  2178.     TempMasREC(1) = MastRec
  2179.     TempIdxREC(1) = IndexRec
  2180.  
  2181.    ELSE
  2182.     PRINT CORRUPT
  2183.     END
  2184.    END IF
  2185.  
  2186.    PrevMastRec = MastRec
  2187.    PrevIndexRec = IndexRec
  2188.  
  2189.    CurrentROW = 1
  2190.  
  2191. GetNextCten:
  2192.  
  2193.    FOR lineNum = 2 TO height
  2194.     TempMasREC(lineNum) = 0
  2195.     TempIdxREC(lineNum) = 0
  2196.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2197.    NEXT lineNum
  2198.  
  2199.    FOR lineNum = 2 TO height
  2200.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2201.     TempMasREC(lineNum) = 0
  2202.     TempIdxREC(lineNum) = 0
  2203.  
  2204.     PIM "N", indexnum, key$, MastRec, IndexRec
  2205.  
  2206.     IF IndexRec > 0 THEN
  2207.      IF PrevMastRec = MastRec AND IndexRec = PrevIndexRec THEN
  2208.       EXIT FOR
  2209.      ELSE
  2210.       GOSUB getrecinfo
  2211.       DispLine$(lineNum) = DispLine$
  2212.       TempMasREC(lineNum) = MastRec
  2213.       TempIdxREC(lineNum) = IndexRec
  2214.       PrevMastRec = MastRec
  2215.       PrevIndexRec = IndexRec
  2216.  
  2217.      END IF
  2218.     ELSE
  2219.      EXIT FOR
  2220.     END IF
  2221.    NEXT lineNum
  2222.  
  2223.    RETURN
  2224.  
  2225. endCkeys:
  2226.    dsppos = 1
  2227.    FOR lineNum = 1 TO height
  2228.     TempMasREC(lineNum) = 0
  2229.     TempIdxREC(lineNum) = 0
  2230.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2231.    NEXT lineNum
  2232.  
  2233.    PIM "L", indexnum, key$, MastRec, IndexRec
  2234.  
  2235.    IF IndexRec THEN
  2236.  
  2237.     GOSUB getrecinfo
  2238.     DispLine$(height) = DispLine$
  2239.     TempMasREC(height) = MastRec
  2240.     TempIdxREC(height) = IndexRec
  2241.    ELSE
  2242.     PRINT CORRUPT
  2243.     END
  2244.    END IF
  2245.  
  2246.    PrevMastRec = MastRec
  2247.    PrevIndexRec = IndexRec
  2248.    CurrentROW = 1
  2249.  
  2250. GetPreviousCten:
  2251.  
  2252.    FOR lineNum = 1 TO height - 1
  2253.     TempMasREC(lineNum) = 0
  2254.     TempIdxREC(lineNum) = 0
  2255.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2256.    NEXT lineNum
  2257.    startpos = 1
  2258.    FOR lineNum = height - 1 TO 1 STEP -1
  2259.  
  2260.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2261.  
  2262.     PIM "P", indexnum, key$, MastRec, IndexRec
  2263.  
  2264.     IF IndexRec > 0 THEN
  2265.      IF PrevIndexRec = IndexRec AND PrevMastRec = MastRec THEN
  2266.  
  2267.       EXIT FOR
  2268.      ELSE
  2269.       startpos = startpos + 1
  2270.       GOSUB getrecinfo
  2271.       DispLine$(lineNum) = DispLine$
  2272.       TempMasREC(lineNum) = MastRec
  2273.       TempIdxREC(lineNum) = IndexRec
  2274.       PrevMastRec = MastRec
  2275.       PrevIndexRec = IndexRec
  2276.       startrpos = startpos + 1
  2277.  
  2278.      END IF
  2279.     ELSE
  2280.  
  2281.      EXIT FOR
  2282.     END IF
  2283.    NEXT lineNum
  2284.  
  2285.    RETURN
  2286.  
  2287. GetnextCpage:
  2288.  
  2289.    key$ = DispLine$(height)
  2290.    MastRec = TempMasREC(height)
  2291.  
  2292.    FOR lineNum = 1 TO 2
  2293.     TempMasREC(lineNum) = 0
  2294.     TempIdxREC(lineNum) = 0
  2295.     PrevMastRec = 0
  2296.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2297.    NEXT lineNum
  2298.  
  2299.    PIM "N", indexnum, key$, MastRec, IndexRec
  2300.  
  2301.    IF IndexRec THEN
  2302.     GOSUB getrecinfo
  2303.     DispLine$(1) = DispLine$
  2304.     TempMasREC(1) = MastRec
  2305.     TempIdxREC(1) = IndexRec
  2306.    ELSE
  2307.     GOTO endCkeys
  2308.     RETURN
  2309.    END IF
  2310.  
  2311.    PrevMastRec = MastRec
  2312.    PrevIndexRec = IndexRec
  2313.    CurrentROW = 1
  2314.  
  2315. GetNextCpg:
  2316.  
  2317.    FOR lineNum = 2 TO height
  2318.     TempMasREC(lineNum) = 0
  2319.     TempIdxREC(lineNum) = 0
  2320.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2321.    NEXT lineNum
  2322.  
  2323.    FOR lineNum = 2 TO height
  2324.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2325.     TempMasREC(lineNum) = 0
  2326.     TempIdxREC(lineNum) = 0
  2327.  
  2328. 'get Next record
  2329.     PIM "N", indexnum, key$, MastRec, IndexRec
  2330.     IF IndexRec > 0 THEN
  2331.      IF PrevMastRec = MastRec AND IndexRec = PrevIndexRec THEN
  2332.       GOTO endCkeys
  2333.  
  2334.      ELSE
  2335.       GOSUB getrecinfo
  2336.       DispLine$(lineNum) = DispLine$
  2337.       TempMasREC(lineNum) = MastRec
  2338.       TempIdxREC(lineNum) = IndexRec
  2339.       PrevMastRec = MastRec
  2340.       PrevIndexRec = IndexRec
  2341.  
  2342.      END IF
  2343.     ELSE
  2344.  
  2345.      GOTO endCkeys
  2346.  
  2347.     END IF
  2348.  
  2349.    NEXT lineNum
  2350.  
  2351.    RETURN
  2352.  
  2353. GetLastCpage:
  2354.  
  2355.    key$ = DispLine$(1)
  2356.    MastRec = TempMasREC(1)
  2357.  
  2358.    FOR lineNum = 1 TO height
  2359.     TempMasREC(lineNum) = 0
  2360.     TempIdxREC(lineNum) = 0
  2361.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2362.    NEXT lineNum
  2363.  
  2364.    PIM "P", indexnum, key$, MastRec, IndexRec
  2365.  
  2366.    IF IndexRec THEN
  2367.  
  2368.     GOSUB getrecinfo
  2369.     DispLine$(height) = DispLine$
  2370.     TempMasREC(height) = MastRec
  2371.     TempIdxREC(height) = IndexRec
  2372.    ELSE
  2373.     GOTO homeCkeys
  2374.    END IF
  2375.  
  2376.    PrevMastRec = MastRec
  2377.    PrevIndexRec = IndexRec
  2378.    CurrentROW = 1
  2379.  
  2380. GetLastCpg:
  2381.  
  2382.    FOR lineNum = 1 TO height - 1
  2383.     TempMasREC(lineNum) = 0
  2384.     TempIdxREC(lineNum) = 0
  2385.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2386.    NEXT lineNum
  2387.  
  2388.    FOR lineNum = height - 1 TO 1 STEP -1
  2389.     DispLine$(lineNum) = STRING$(KeyLen, 32)
  2390.  
  2391.     PIM "P", indexnum, key$, MastRec, IndexRec
  2392.  
  2393.     IF IndexRec > 0 THEN
  2394.      IF PrevIndexRec = IndexRec AND PrevMastRec = MastRec THEN
  2395.       GOTO homeCkeys
  2396.      ELSE
  2397.       GOSUB getrecinfo
  2398.       DispLine$(lineNum) = DispLine$
  2399.       TempMasREC(lineNum) = MastRec
  2400.       TempIdxREC(lineNum) = IndexRec
  2401.       PrevMastRec = MastRec
  2402.       PrevIndexRec = IndexRec
  2403.  
  2404.      END IF
  2405.     END IF
  2406.    NEXT lineNum
  2407.  
  2408.    RETURN
  2409.  
  2410. getrecinfo: 'add if more than key RecField is displayed
  2411. '
  2412.    GET #datfile, MastRec, RecField
  2413.  
  2414.    cnam$ = RecField.name
  2415.    Cnum$ = RecField.Num
  2416. 'RecField.progname
  2417. 'RecField.length
  2418.    cph1$ = RecField.format
  2419. 'trim tint$
  2420. 'RecField.type
  2421. 'RecField.case
  2422. 'RecField.decimal
  2423. 'RecField.comment
  2424. 'RecField.frow
  2425.    tcap$ = RecField.fcol
  2426.  
  2427. '      IF indexnum = 1 THEN
  2428.    DispLine$ = cnam$  'add$' + " " + cph1$
  2429. '       ELSE
  2430. '       DispLine$ = cln$ + " " + tcap$
  2431. '      END IF
  2432.    RETURN
  2433.  
  2434.   END SUB
  2435.  
  2436.   SUB seldatafile
  2437.    mainscreen
  2438.    MsgLine "Press  " + CHR$(24) + " for last " + CHR$(25) + " for next  ENTER to select", 25, 0, 7
  2439.  
  2440.    DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  2441.    CenterText "Select RecField Database", 22, BLACK, WHITE
  2442. tryagian:
  2443.    filespec$ = SelFiles$("*.FLD")
  2444.    delimit = INSTR(filespec$, ".")
  2445.  
  2446.    IF delimit THEN
  2447.     FileName$ = LEFT$(filespec$, delimit - 1)
  2448.     fileext$ = RIGHT$(filespec$, LEN(filespec$) - (delimit))
  2449.    ELSE
  2450.     FileName$ = filespec$
  2451.     fileext$ = ".FLD"
  2452.    END IF
  2453.  
  2454.    Trim FileName$
  2455.    IF FileName$ = "" THEN
  2456.     masterFile$ = ""
  2457.    ELSE
  2458.     masterFile$ = FileName$ + "." + fileext$
  2459.    END IF
  2460.  
  2461.   END SUB
  2462.  
  2463.