home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / BASIC / PROGEN / SAMPLE.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-12-01  |  34.5 KB  |  1,286 lines
  1. '
  2. 'ISAM DATABASE Program Generator Version: 7.1
  3. 'YOUR PROGRAM.: SAMPLE.BAS 
  4. 'CREATED ON...: 10-09-1991, 00:05:52
  5. '
  6. 'PROGRAM NAME.: SAMPLE
  7. 'LIB,QLB CODE.:  By: RAYMOND E DIXON 1991
  8. '                      11660 VC JOHNSON RD.
  9. '                   Jacksonville, FL 32218
  10. '                      (904) 765-4048
  11. '
  12. ' Computer generated on.
  13. '
  14. 'CPU TYPE.....:    80286
  15. 'VIDEO ADAPTER: VGA Color
  16. 'ROM BIOS DATE: 04/30/89
  17. 'DOS RAM......:     640K
  18. 'EXTENDED RAM.:    1024K
  19. 'EXPANDED RAM.:     704K
  20. 'PRINTERS.....:       2
  21. 'RS232........:       4
  22. 'FLOPPIES.....:       2
  23. 'HARD DRIVES..:       1
  24. 'GAME PORTS...:       0
  25. '
  26. '
  27. DEFINT A-Z
  28. DECLARE FUNCTION ISMstatus% (indexnum%)
  29. DECLARE SUB BrowseIRec (nameofindex$,indexnum%,retcode%)
  30. DECLARE SUB mainscreen ()
  31. DECLARE SUB msg.nodata ()
  32. DECLARE SUB PROSAM.scn1 ()
  33. DECLARE SUB ISM (cmd$, indexnum%, retcode%)
  34.  
  35. '         Microsoft BC    7.1, Professional Development System
  36. '         Microsoft QBX   7.1, Professional Development System
  37. '         Microsoft ISAM  7.1, Professional Development System
  38. '            Copyright (C) 1987-1989, Microsoft Corporation
  39. '
  40. '         PROGEN71.EXE, PROGEN71.OBJ and files
  41. '         PROGEN71.LIB, PROGEN71.QLB and source are
  42. '         Copyrighted (C)  1991 by: RAYMOND E DIXON
  43. '
  44. '                  RAYMOND E DIXON
  45. '                  11660 VC JOHNSON RD.
  46. '               Jacksonville, Fl. 32218
  47. '
  48. '                  (904) 765-4048
  49.  
  50.  COMMON SHARED masterfile$,key$
  51.  
  52. ' $INCLUDE: 'PROLIB71.BI'
  53.  
  54. 'define record type here
  55.  
  56.    TYPE RecordType
  57.          status as STRING * 1  ' set for record used
  58.          LASTNAME AS  STRING * 14
  59.          FIRSTNAME AS  STRING * 14
  60.          ADDRESS AS  STRING * 34
  61.          PHONE1 AS  STRING * 7 
  62.          PHONE2 AS  STRING * 10
  63.  END TYPE
  64.  
  65.  DIM SHARED TestRecField AS RecordType
  66.  DIM SHARED RecField AS RecordType
  67.  DIM DispLine$(30)
  68.  DIM sf$(20)   
  69.  
  70.    fg = white
  71.    bg = BLUE
  72.    rev = RED
  73.  CONST startp = 10
  74.  LOCATE 25, 1, 0, 0, 0
  75.  COLOR white, BLUE
  76.  
  77.    mainscreen
  78.   CONST keyindex = 1
  79.   masterfile$ = "SAMPLE.DBF"
  80.  
  81. NEWFILE:
  82.  
  83.    IF FileExists(masterfile$) = 0 THEN  'If no index then create
  84.    OPEN masterfile$ FOR ISAM Recordtype "database" AS keyindex  'Open the data file
  85.  
  86.    Createindex KeyIndex,"IndexLASTNAME",0,"LASTNAME"
  87.    Createindex KeyIndex,"IndexFIRSTNAME",0,"FIRSTNAME"
  88.    ELSE
  89.    OPEN masterfile$ FOR ISAM Recordtype "database" AS keyindex  'Open the data file
  90.    END IF
  91.  
  92.  
  93.    DO
  94.       mainscreen
  95.  
  96.       DrawBox 21, 22, 40, 3, 2, black, white, 1, black, white, 1
  97.       CenterText "Current Data File :" + masterfile$, 22, black, white
  98.  
  99.               menu$ = "Add a new Record\"
  100.       menu$ = menu$ + "Browse/Edit Record's\"
  101.       menu$ = menu$ + "Print by Record #\"
  102.       menu$ = menu$ + "Delete a Record\"
  103.       menu$ = menu$ + "Erase  datafile\"
  104.       menu$ = menu$ + "System information\"
  105.       menu$ = menu$ + "Quit (Return to DOS)\"
  106.  
  107.       mopt = MenuWindow(0, 0, menu$,"Main Menu", black, white, RED, 0)
  108.  
  109.       'Get the option
  110.  
  111.       SELECT CASE mopt  'Select on choice
  112.  
  113.          CASE 1  'Insert a new record
  114.             mainscreen
  115.             GOSUB InitRecField ' set all fields to null
  116.             GOSUB getfieldinfo ' get new record info
  117.  
  118.          CASE 2  'Browse through Records
  119.             mainscreen
  120.             Imopt = 1
  121.  
  122.             DO
  123.                 IF ISMstatus(keyindex) = 0 THEN
  124.                   msg.nodata
  125.                   EXIT DO
  126.                END IF
  127.  
  128.  
  129.                     sf$( 1) = "LASTNAME       "
  130.                     sf$( 2) = "FIRSTNAME      "
  131.  
  132.                     sf = selbox(sf$(), 2, 2,16, black, white, RED )
  133.              SELECT CASE SF
  134.  
  135.              CASE  1
  136.                key$= string$(len(RecField.LASTNAME)," ")
  137.                setindex KeyIndex, "IndexLASTNAME"
  138.                 nameofindex$ = "IndexLASTNAME"
  139.              CASE  2
  140.                key$= string$(len(RecField.FIRSTNAME)," ")
  141.                setindex KeyIndex, "IndexFIRSTNAME"
  142.                 nameofindex$ = "IndexFIRSTNAME"
  143.             END SELECT
  144.  
  145.                MOVEFIRST keyindex
  146.  
  147.                BrowseIrec nameofindex$, keyindex, Exitcode
  148.  
  149.                IF Exitcode = 0 THEN
  150.                   msg.nodata
  151.                   EXIT DO
  152.                END IF
  153.  
  154.                IF Exitcode = 1 THEN
  155.                   EXIT DO
  156.                END IF
  157.  
  158.                WHILE Exitcode = 2
  159.  
  160.                   RETRIEVE keyindex, RecField
  161.  
  162.                   CALL SAMPLE.scn1
  163.                   CALL SAMPLE.info1
  164.                   LOCATE 21, 2
  165.  
  166.                    CenterText "                                                          ", 21, fg, bg
  167.                    CenterText "Index in use: " + GETINDEX$(keyindex), 21, fg, bg
  168.  
  169.                   BO$ = "           Next        Prev        Search         Edit        Menu          "
  170.  
  171.                   Imopt = MenuBar(25, 3, BO$, BLACK, WHITE, RED, Imopt)
  172.  
  173.                   IF Imopt = 3 THEN
  174.                        Exitcode = 0
  175.                   END IF
  176.  
  177.                   IF Imopt = 4 THEN
  178.                      mopt = 2
  179.                      GOSUB getfieldinfo
  180.                   END IF
  181.  
  182.                   IF Imopt = 5 THEN
  183.                      EXIT DO
  184.                   END IF
  185.  
  186.                   IF Imopt = 1 THEN
  187.                      MOVENEXT keyindex 
  188.                     pnc "░░░░░░░░░░░░░░░░░░░░░░", 24, 11, fg, bg
  189.  
  190.                   IF EOF(keyindex) THEN
  191.                     MOVELAST keyindex
  192.                     pnc "** At Last record **", 24, 11, fg + 8, bg
  193.  
  194.                   END IF
  195.  
  196.                   END IF
  197.  
  198.                   IF Imopt = 2 THEN
  199.  
  200.                      MOVEPREVIOUS keyindex 
  201.                     pnc "░░░░░░░░░░░░░░░░░░░░░░", 24, 11, fg, bg
  202.  
  203.                      IF BOF(keyindex) THEN
  204.                      MOVEFIRST keyindex
  205.                      pnc "** At First record **", 24, 11, fg + 8, bg
  206.                   END IF
  207.                   END IF
  208.  
  209.                   RETRIEVE keyindex, RecField
  210.  
  211.                WEND
  212.             LOOP
  213.          CASE 3  'Print all selected records
  214.                DO
  215.  
  216.                 IF ISMstatus(keyindex) = 0 THEN
  217.                   msg.nodata
  218.                   EXIT DO
  219.                 END IF
  220.  
  221.                     sf$( 1) = "LASTNAME       "
  222.                     captal sf$( 1)
  223.                     sf$( 2) = "FIRSTNAME      "
  224.                     captal sf$( 2)
  225.  
  226.                     sf = selbox(sf$(), 2, 2,16, black, white, RED )
  227.  
  228.              SELECT CASE SF
  229.              CASE  1
  230.                key$= string$(len(RecField.LASTNAME)," ")
  231.                setindex KeyIndex, "IndexLASTNAME"
  232.                 nameofindex$ = "IndexLASTNAME"
  233.              CASE  2
  234.                key$= string$(len(RecField.FIRSTNAME)," ")
  235.                setindex KeyIndex, "IndexFIRSTNAME"
  236.                 nameofindex$ = "IndexFIRSTNAME"
  237.             END SELECT
  238.  
  239.  
  240.             DispLine$(1) = "Enter Starting Rec "
  241.             DispLine$(2) = "Enter for all"
  242.  
  243.             ans$ = ""
  244.  
  245.             DialogBox DispLine$(), 1, 1, nl, BLACK, WHITE, BLACK, WHITE, 1, ans$,"", Exk
  246.             key$ = ans$
  247.             DispLine$(1) = "Print to Display or Printer"
  248.             Ques$ = "(D/P)"
  249.             answ$ = "DdPp"
  250.             AskQuestion DispLine$(), 1, 1, 1, BLACK, WHITE, BLACK, WHITE, Ques$, answ$
  251.  
  252.             IF UCASE$(answ$) = "D" THEN
  253.                output$ = "CONS:"
  254.                CLS
  255.             ELSE
  256.                output$ = "LPT1:"
  257.                IF CheckPrinter <> 1 THEN EXIT DO
  258.             END IF
  259.  
  260.             prt = FREEFILE
  261.  
  262.             OPEN output$ FOR OUTPUT AS #prt
  263.             WIDTH #prt, 80
  264.             'Print the DB in sequence
  265.  
  266.             IF key$ = "" THEN
  267.             ISM "F", keyindex, indexrec
  268.             ELSE
  269.             ISM "EQ", keyindex, indexrec
  270.             END IF
  271.  
  272.             IF indexrec THEN
  273.  
  274.                RETRIEVE keyindex, RecField
  275.                 lp$ =  userSformat((RTRIM$(RecField.LASTNAME)),"@@@@@@@@@@@@@@") + " "
  276.                 lp$ = lp$ + userSformat((RTRIM$(RecField.FIRSTNAME)),"@@@@@@@@@@@@@@") + " "
  277.                 lp$ = lp$ + userSformat((RTRIM$(RecField.ADDRESS)),"##################################") + " "
  278.                 lp$ = lp$ + userSformat((RTRIM$(RecField.PHONE1)),"999-9999") + " "
  279.                 lp$ = lp$ + userSformat((RTRIM$(RecField.PHONE2)),"(999) 999-9999") + " "
  280.  
  281.                IF output$ = "LPT1:" THEN
  282.                   PRINT #prt, LP$
  283.                 ELSE
  284.                   PRINT #prt, LEFT$(LP$,79)
  285.                 END IF
  286.  
  287.                DO WHILE indexrec
  288.  
  289.                   ISM "N", keyindex, indexrec
  290.                   IF indexrec = 1 THEN
  291.                   RETRIEVE keyindex, RecField
  292.  
  293.                 lp$ =  userSformat((RTRIM$(RecField.LASTNAME)),"@@@@@@@@@@@@@@") + " "
  294.                 lp$ = lp$ + userSformat((RTRIM$(RecField.FIRSTNAME)),"@@@@@@@@@@@@@@") + " "
  295.                 lp$ = lp$ + userSformat((RTRIM$(RecField.ADDRESS)),"##################################") + " "
  296.                 lp$ = lp$ + userSformat((RTRIM$(RecField.PHONE1)),"999-9999") + " "
  297.                 lp$ = lp$ + userSformat((RTRIM$(RecField.PHONE2)),"(999) 999-9999") + " "
  298.                IF output$ = "LPT1:" THEN
  299.                   PRINT #prt, LP$
  300.                 ELSE
  301.                   PRINT #prt, LEFT$(LP$,79)
  302.                 END IF
  303.                ENDIF
  304.                LOOP
  305.  
  306.                IF output$ = "LPT1:" THEN
  307.                   PRINT #prt, CHR$(12)
  308.                ELSE
  309.                   waitkey 24, fg, bg
  310.                END IF
  311.                CLOSE #prt
  312.             END IF
  313.  
  314.             EXIT DO
  315.             LOOP
  316.  
  317.          CASE 4  'Delete a record
  318.  
  319.             DO
  320.                 IF ISMstatus(keyindex) = 0 THEN
  321.                   msg.nodata
  322.                   EXIT DO
  323.                END IF
  324.  
  325.  
  326.                     MsgLine "Press   for last  for next  ENTER to select",25 , 0, 7
  327.                     DrawBox 21, 22, 40, 3, 2, black, white, 1, black, white, 1
  328.                     CenterText "Select RecField Database", 22, black, white
  329.  
  330.                     sf$( 1) = "LASTNAME       "
  331.                     sf$( 2) = "FIRSTNAME      "
  332.  
  333.              sf = selbox(sf$(), 2, 2,16, black, white, RED )
  334.  
  335.              SELECT CASE SF
  336.              CASE  1
  337.                key$= string$(len(RecField.LASTNAME)," ")
  338.                setindex KeyIndex, "IndexLASTNAME"
  339.                 nameofindex$ = "IndexLASTNAME"
  340.              CASE  2
  341.                key$= string$(len(RecField.FIRSTNAME)," ")
  342.                setindex KeyIndex, "IndexFIRSTNAME"
  343.                 nameofindex$ = "IndexFIRSTNAME"
  344.  
  345.             END SELECT
  346.                BrowseIrec nameofindex$, keyindex, Exitcode
  347.  
  348.                IF Exitcode = 0 THEN  'Index is Empty
  349.                   msg.nodata
  350.                   EXIT DO
  351.                END IF
  352.  
  353.                      RETRIEVE keyindex, RecField
  354.                      'display the details
  355.                      CALL SAMPLE.scn1'0
  356.                      CALL SAMPLE.info1
  357.  
  358.                      DispLine$(1) = "YES, go ahead and delete displayed record   : "+KEY$
  359.                      DispLine$(2) = "NO, I don't want to delete displayed record : "+KEY$
  360.  
  361.                      Imopt = 1
  362.                      Ques$ = "(Y/N)"
  363.                      answ$ = "YyNn"
  364.  
  365.                      AskQuestion DispLine$(), 2, 1, 2, BLACK, WHITE, BLACK, WHITE, Ques$, answ$
  366.  
  367.                      IF UCASE$(answ$) = "Y" THEN
  368.  
  369.                         GOSUB InitRecField  'Initialize NAME
  370.                         DELETE keyindex
  371.  
  372.                      END IF
  373.                      EXIT DO
  374.             LOOP
  375.  
  376.  
  377.          CASE 5  '!!! DELETE ALL DATA AND KEY FILES !!!
  378.  
  379.             DrawBox 21, 22, 40, 3, 2, BLACK, WHITE, 1, BLACK, WHITE, 1
  380.  
  381.             CenterText "Select File to Delete ", 22, BLACK, WHITE
  382.             MsgLine "Press   for last  for next  ENTER to select", 25, 0, 7
  383.  
  384.             MFILE$ = SelFiles$("*.DBF")
  385.  
  386.             trim MFILE$
  387.             masterfile$ = MFILE$
  388.  
  389.             IF MFILE$ <> "" THEN
  390.                DispLine$(1) = "Delete "+ MFILE$ +", Are You Sure ?"
  391.                DispLine$(2) = "Yes to erase"+ MFILE$
  392.                Ques$ = "(Y/N)"
  393.                ans$ = "YyNn"
  394.  
  395.                AskQuestion DispLine$(), 2, 1, 1, BLACK, WHITE, BLACK, WHITE, Ques$, ans$
  396.  
  397.                IF UCASE$(ans$) = "Y" THEN
  398.                  CLOSE
  399.  
  400.                   delimit = INSTR(masterfile$, ".")
  401.  
  402.                   IF delimit THEN
  403.                   dfile$ = LEFT$(masterfile$, delimit - 1)
  404.                   ELSE
  405.                   dfile$ = masterfile$
  406.                   END IF
  407.  
  408.                   KILL dfile$ + ".DBF"
  409.  
  410.                   GOTO NEWFILE
  411.  
  412.                END IF
  413.             END IF
  414.  
  415.          CASE 6 ' display equipment 
  416.  
  417.             DspEquipment
  418.  
  419.          CASE 7  'QUIT exit to dos
  420.  
  421.  
  422.             CLOSE
  423.             EXIT DO
  424.  
  425.          CASE 99
  426.          CASE ELSE
  427.       END SELECT
  428.    LOOP
  429.  
  430.    LOCATE 23, 1
  431.    COLOR white, black
  432.    CLS
  433.    END  'End of program
  434. getfieldinfo:  ' prints screens and gets record info
  435.  
  436.    op = 1
  437.  
  438.    DO ' loop until page down or esc key
  439.  
  440.          pnc "ESC to exit PgDn TO update,  for prev  for next F1 edit help", 25, 10, 0, 7 
  441.  
  442.       SELECT CASE OP
  443.  
  444.               CASE 1  '                              
  445.  
  446.               CALL SAMPLE.scn1
  447.               CALL SAMPLE.info1
  448.  
  449.               LOCATE 11,22
  450.               format$ = "@@@@@@@@@@@@@@"
  451.               edit$ = RecField.LASTNAME
  452.               Trim edit$
  453.               edit$ = FES(0, WHITE, BLACK, edit$, format$, 0, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  454.               RecField.LASTNAME= edit$
  455.  
  456.               SELECT CASE Ek   ' get exit key
  457.                      CASE 1
  458.                      op = op - 1 ' goto previous field
  459.                      CASE 5
  460.                      op = op + 1 ' goto next field
  461.                      CASE 3
  462.                      op = op + 1
  463.                      CASE 4
  464.                      op =  6  'page down so update
  465.                      CASE 7
  466.                      op = 999 'ESC key so exit
  467.               END SELECT
  468.  
  469.               CASE 2  '                              
  470.  
  471.               LOCATE 12,22
  472.               format$ = "@@@@@@@@@@@@@@"
  473.               edit$ = RecField.FIRSTNAME
  474.               Trim edit$
  475.               edit$ = FES(0, WHITE, BLACK, edit$, format$, 0, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  476.               RecField.FIRSTNAME= edit$
  477.  
  478.               SELECT CASE Ek   ' get exit key
  479.                      CASE 1
  480.                      op = op - 1 ' goto previous field
  481.                      CASE 5
  482.                      op = op + 1 ' goto next field
  483.                      CASE 3
  484.                      op = op + 1
  485.                      CASE 4
  486.                      op =  6  'page down so update
  487.                      CASE 7
  488.                      op = 999 'ESC key so exit
  489.               END SELECT
  490.  
  491.               CASE 3  '                              
  492.  
  493.               LOCATE 13,22
  494.               format$ = "##################################"
  495.               edit$ = RecField.ADDRESS
  496.               Trim edit$
  497.               edit$ = FES(0, WHITE, BLACK, edit$, format$, 1, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  498.               RecField.ADDRESS= edit$
  499.  
  500.               SELECT CASE Ek   ' get exit key
  501.                      CASE 1
  502.                      op = op - 1 ' goto previous field
  503.                      CASE 5
  504.                      op = op + 1 ' goto next field
  505.                      CASE 3
  506.                      op = op + 1
  507.                      CASE 4
  508.                      op =  6  'page down so update
  509.                      CASE 7
  510.                      op = 999 'ESC key so exit
  511.               END SELECT
  512.  
  513.               CASE 4  '                              
  514.  
  515.               LOCATE 14,22
  516.               format$ = "999-9999"
  517.               edit$ = RecField.PHONE1
  518.               Trim edit$
  519.               edit$ = FES(0, WHITE, BLACK, edit$, format$, 0, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  520.               RecField.PHONE1= edit$
  521.  
  522.               SELECT CASE Ek   ' get exit key
  523.                      CASE 1
  524.                      op = op - 1 ' goto previous field
  525.                      CASE 5
  526.                      op = op + 1 ' goto next field
  527.                      CASE 3
  528.                      op = op + 1
  529.                      CASE 4
  530.                      op =  6  'page down so update
  531.                      CASE 7
  532.                      op = 999 'ESC key so exit
  533.               END SELECT
  534.  
  535.               CASE 5  '                              
  536.  
  537.               LOCATE 15,22
  538.               format$ = "(999) 999-9999"
  539.               edit$ = RecField.PHONE2
  540.               Trim edit$
  541.               edit$ = FES(0, WHITE, BLACK, edit$, format$, 0, Ek, 1, 0, 1, 1, 1, 0, 1, 0)
  542.               RecField.PHONE2= edit$
  543.  
  544.               SELECT CASE Ek   ' get exit key
  545.                      CASE 1
  546.                      op = op - 1 ' goto previous field
  547.                      CASE 5
  548.                      op = op + 1 ' goto next field
  549.                      CASE 3
  550.                      op = op + 1
  551.                      CASE 4
  552.                      op =  6  'page down so update
  553.                      CASE 7
  554.                      op = 999 'ESC key so exit
  555.               END SELECT
  556.  
  557.               CASE  6  'END REACHED
  558.  
  559.               SELECT CASE mopt  'do option
  560.  
  561.          'INSERT or Change record key
  562.  
  563.               CASE 1  'INSERT
  564.  
  565.                   INSERT keyindex, RecField
  566.                   CHECKPOINT
  567.                   EXIT DO  'INSERTED!
  568.  
  569.               CASE 2  'Edit, Update
  570.  
  571.                   UPDATE keyindex, RecField
  572.                   CHECKPOINT ' update isam record
  573.                   EXIT DO
  574.           CASE ELSE
  575.   END SELECT
  576.  
  577.   CASE 999
  578.   EXIT DO
  579.   CASE ELSE
  580.    END
  581.   END SELECT
  582.   LOOP
  583.   RETURN
  584.  
  585. InitRecField:
  586.        RecField.LASTNAME = ""
  587.        RecField.FIRSTNAME = ""
  588.        RecField.ADDRESS = ""
  589.        RecField.PHONE1 = ""
  590.        RecField.PHONE2 = ""
  591. RETURN
  592. DEFINT A-Z
  593.   sub SAMPLE.scn1    static
  594.  
  595.                 'Display details on screen
  596.     fg = white 
  597.     bg = blue 
  598.  
  599.         pnc "LASTNAME        : ██████████████",11,4,fg,bg
  600.         pnc "FIRSTNAME       : ██████████████",12,4,fg,bg
  601.         pnc "ADDRESS         : ██████████████████████████████████",13,4,fg,bg
  602.         pnc "PHONE1          : ████████",14,4,fg,bg
  603.         pnc "PHONE2          : ██████████████",15,4,fg,bg
  604.   end sub ' SAMPLE
  605. DEFINT A-Z
  606.   sub SAMPLE.info1    static
  607.  
  608.                 'Display details on screen
  609.     fg = white 
  610.     bg = blue 
  611.  
  612.         fg = black
  613.         bg = white
  614.         PNC userSformat ((RTRIM$(RecField.LASTNAME)),"@@@@@@@@@@@@@@"),11,22, fg, bg
  615.         fg = black
  616.         bg = white
  617.         PNC userSformat ((RTRIM$(RecField.FIRSTNAME)),"@@@@@@@@@@@@@@"),12,22, fg, bg
  618.         fg = black
  619.         bg = white
  620.         PNC userSformat ((RTRIM$(RecField.ADDRESS)),"##################################"),13,22, fg, bg
  621.         fg = black
  622.         bg = white
  623.         PNC userSformat ((RTRIM$(RecField.PHONE1)),"999-9999"),14,22, fg, bg
  624.         fg = black
  625.         bg = white
  626.         PNC userSformat ((RTRIM$(RecField.PHONE2)),"(999) 999-9999"),15,22, fg, bg
  627.   end sub ' SAMPLE
  628. DEFINT A-Z
  629. '
  630.    SUB mainscreen
  631.    bg = white
  632.    fg = black
  633.    rev = RED
  634.    COLOR white, BLUE
  635.    DrawBox 1, 1, 80, 25, 2, white, BLUE, 4, white, BLUE, 0
  636.    DrawBox 2, 20, 40, 4, 2, black, white, 1, black, white, 1
  637.    CenterText " the PROGEN database ", 3, fg, bg 
  638.    CenterText "By: RAYMOND E DIXON Jacksonville FL", 4, fg, bg
  639.    END SUB
  640.  
  641. DEFINT A-Z
  642. '
  643. ' return code = 1 if record exist 0 if no record
  644. '
  645.    SUB ISM (cmd$, indexnum, retcode)
  646.             trim cmd$
  647.  
  648.       KIMcmd$ = UCASE$(cmd$)
  649.  
  650.       SELECT CASE KIMcmd$
  651.  
  652.        CASE "A" 'add new record
  653.        CASE "F" 'move to first record
  654.        CASE "P" 'move to previous record
  655.        CASE "N"
  656.        CASE "L"
  657.        CASE "D"
  658.        CASE "GE"
  659.        CASE "GT"
  660.        CASE "EQ"
  661.        CASE ELSE
  662.            EXIT SUB
  663.        END SELECT
  664.  
  665.       SELECT CASE KIMcmd$
  666.  
  667. '******************************************
  668.          CASE "F"'find first
  669. '******************************************
  670.          MOVEFIRST indexnum
  671.          IF BOF(indexnum) THEN
  672.          retcode = 0
  673.          ELSE
  674.          retcode = 1
  675.          END IF
  676.  
  677. '******************************************
  678.          CASE "L"'find last key
  679. '******************************************
  680.          MOVELAST indexnum
  681.           IF EOF(indexnum) THEN
  682.           retcode = 0
  683.           ELSE
  684.           retcode = 1
  685.           END IF
  686. '******************************************
  687.          CASE "EQ"'search for key   =
  688. '******************************************
  689.          SEEKEQ indexnum, key$
  690.           IF EOF(indexnum) THEN
  691.           MOVELAST indexnum
  692.           retcode = 0
  693.           ELSE
  694.           retcode = 1
  695.           END IF
  696. '******************************************
  697.          CASE "GE"   'search for key  >=
  698. '******************************************
  699.          SEEKGE indexnum, key$
  700.           IF EOF(indexnum) THEN
  701.           MOVELAST indexnum
  702.           retcode = 0
  703.           ELSE
  704.           retcode = 1
  705.           END IF
  706. '******************************************
  707.          CASE "GT"  'search for key >
  708. '******************************************
  709.          SEEKGT indexnum, key$
  710.           IF EOF(indexnum) THEN
  711.           MOVELAST indexnum
  712.           retcode = 0
  713.           ELSE
  714.           retcode = 1
  715.           END IF
  716. '******************************************
  717.          CASE "A"   'add new key
  718. '******************************************
  719.          INSERT indexnum, RecField
  720.          retcode = 1
  721. '******************************************
  722.          CASE "D"   'delete existing key
  723. '******************************************
  724.          DELETE indexnum
  725.          retcode = 1
  726. '******************************************
  727.          CASE "N"  ' next key
  728. '******************************************
  729.           MOVENEXT indexnum
  730.           IF EOF(indexnum) THEN
  731.           MOVELAST indexnum
  732.           retcode = 0
  733.           ELSE
  734.           retcode = 1
  735.           END IF
  736. '******************************************
  737.          CASE "P"  ' previous key
  738. '******************************************
  739.          MOVEPREVIOUS indexnum
  740.          IF BOF(indexnum) THEN
  741.          MOVEFIRST indexnum
  742.          retcode = 0
  743.          ELSE
  744.          retcode = 1
  745.          END IF
  746.  
  747.      END SELECT
  748.  
  749. END SUB
  750. DEFINT A-Z
  751. '
  752. ' ISMstatus = 1 if records exist, 0 if no records
  753. '
  754. FUNCTION ISMstatus (ixn)
  755.  
  756.       MOVEFIRST ixn
  757.       IF BOF(ixn) THEN
  758.       ISMstatus = 0
  759.       ELSE
  760.       ISMstatus = 1
  761.       END IF
  762.  
  763. END FUNCTION
  764. DEFINT A-Z
  765. '
  766.    SUB BrowseIrec (nameofindex$, indexnum, Exitcode) STATIC
  767.  
  768.        IF ISMstatus(indexnum) = 0 then
  769.           Exitcode = 0
  770.           EXIT SUB
  771.        END IF
  772.  
  773.       fg = WHITE
  774.       bg = BLUE
  775.  
  776.       REDIM dg$(5)
  777.       REDIM DispLine$(10)
  778.       REDIM TEMPretcode(20)
  779.  
  780.       CONST ex$ = " ESC = Exit  ENTER = Select  ? = Key search "
  781.  
  782.       'define select option window
  783.  
  784.       ROW = 6
  785.       col = 3
  786.       lin = 10
  787.       numofsel = 0
  788.  
  789.       Exitcode = 0
  790.       bodertype = 2  'Border type
  791.  
  792.       Nf = BLACK  'Normal Foreground
  793.       Nb = WHITE  'Normal Background
  794.       sf = WHITE + 8  'Select Foreground
  795.       Sb = BLACK  'Select Background
  796.       ff = YELLOW  'Frame Foreground
  797.       Fb = BLACK  'Frame Background
  798.  
  799.       'end of select option's
  800.       MsgLine  ex$, 25, 0, 7
  801. resrt:
  802.  
  803.  
  804.       KeyLen = 70 ' LEN(key$) for single key display
  805.       KeyLen = Maximum(KeyLen, LEN(Ex$))
  806.       skey$ = "FIELD NAME"
  807.       dg$(1) = "Enter search key"
  808.       dg$(2) = "or Part of key  "
  809.  
  810.       height = lin
  811.       Startpos = height
  812.       col = 80 / 2 - KeyLen / 2
  813.  
  814.       dwidth = KeyLen
  815.       trim dg$(1)
  816.       trim dg$(2)
  817.       Dwidth2 = dwidth
  818.       dwidth = dwidth + 2
  819.  
  820.       totalheight = height + 2  'Scroll box height plus borders
  821.       totalheight = totalheight + 2  'Quit Box + ESC + lineNum
  822.       checkheight = totalheight + ROW - 1  'Check the height
  823.  
  824.       IF checkheight > MAXROW THEN
  825.          CurMasREC = 0
  826.          retcode = 0
  827.          EXIT SUB
  828.       END IF
  829.  
  830.       CheckWidth = dwidth + col - 1
  831.  
  832.       IF CheckWidth > 80 THEN
  833.          CurMasREC = 0
  834.          retcode = 0
  835.          EXIT SUB
  836.       END IF
  837.  
  838.       'Save Screen
  839.       GetBackground ROW, col, ROW + totalheight + 2, col + dwidth + 1, buf$
  840.       DrawBox ROW, col, dwidth, totalheight, bodertype, ff, Fb, 1, Nf, Nb, 0
  841.  
  842.       Crow = ROW + height + 1
  843.       Ccol = col + 1
  844.       Acc$ = STRING$(dwidth - 2, 196)
  845.       pnc Acc$, Crow, Ccol, ff, Fb
  846.       Crow = ROW + height + 2
  847.       kcol = Ccol + KeyLen / 2 - LEN(skey$) / 2
  848.       pnc skey$, Crow, kcol, ff, Fb
  849.  
  850.       GOSUB homekeys  'Display from the top
  851.       GOSUB Displaykeys  'Display the keys
  852.  
  853.       CurrentROW = 1  'Current Row
  854.       DO
  855.       Acc$ = DispLine$(CurrentROW)
  856.  
  857.       IF LEN(Acc$) < Dwidth2 - 2 THEN
  858.          Acc$ = Acc$ + STRING$(Dwidth2 - LEN(Acc$), 32)
  859.       END IF
  860.  
  861.       Crow = CurrentROW + ROW
  862.       pnc Acc$, Crow, Ccol, sf, Sb
  863.       kbd$ = ""
  864.  
  865.       WHILE kbd$ = ""
  866.          kbd$ = INKEY$
  867.       WEND
  868.  
  869.  
  870.       IF LEN(kbd$) = 1 THEN
  871.          useroption = ASC(RIGHT$(kbd$, 1))
  872.          SELECT CASE useroption
  873.  
  874.          CASE 63  '? search key
  875.          DialogBox dg$(), 1, 1, 20, ff, Fb, Nf, Nb, 1, ans$,"", Exk
  876.  
  877.          key$ = ans$
  878.  
  879.          'IndexFind
  880.  
  881.          ISM "GE", indexnum, retcode
  882.  
  883.          IF retcode THEN
  884.             GOSUB getreinfo
  885.             DispLine$(1) = DispLine$
  886.          END IF
  887.  
  888.          GOSUB GetNextten
  889.          CurrentROW = 1
  890.          GOSUB Displaykeys
  891.  
  892.          CASE 48 TO 57, 65 TO 90, 97 TO 122  'first letter search
  893.          'IndexFind
  894.          key$ = UCASE$(CHR$(useroption))
  895.  
  896.          ISM "GE", indexnum, retcode
  897.  
  898.          IF retcode THEN
  899.             GOSUB getreinfo
  900.             DispLine$(1) = DispLine$
  901.          END IF
  902.  
  903.          GOSUB GetNextten
  904.          CurrentROW = 1
  905.          GOSUB Displaykeys
  906.          CASE 27  'ESCAPE
  907.          key$ = ""
  908.          retcode = 0
  909.          Exitcode = 1  ' ESC
  910.          EXIT DO
  911.  
  912.          CASE 13  'RETURN
  913.  
  914.          pnt = INSTR(DispLine$(CurrentROW)," ")
  915.  
  916.          key$ = LEFT$(DispLine$(CurrentROW), pnt)
  917.  
  918.          trim key$
  919.  
  920.          ISM "GE", indexnum, retcode
  921.  
  922.          Exitcode = 2  ' RETURN
  923.          EXIT DO
  924.          CASE ELSE
  925.          END SELECT
  926.       END IF
  927.  
  928.  
  929.       IF LEN(kbd$) = 2 THEN
  930.          useroption = ASC(RIGHT$(kbd$, 1))
  931.          SELECT CASE useroption
  932.  
  933.          CASE 71  'Home
  934.          CurrentROW = 1
  935.          GOSUB homekeys
  936.          GOSUB Displaykeys
  937.  
  938.          CASE 81  'pg Down
  939.          CurrentROW = 1
  940.  
  941.          FOR lineNum = 1 TO height
  942.             DispLine$(lineNum) = STRING$(KeyLen, 32)
  943.          NEXT lineNum
  944.  
  945.          ISM "N", indexnum, retcode
  946.  
  947.          IF retcode THEN
  948.             GOSUB getreinfo
  949.             DispLine$(1) = DispLine$
  950.          END IF
  951.  
  952.          GOSUB GetNextten
  953.          GOSUB Displaykeys
  954.  
  955.          CASE 73  'pg Up
  956.          CurrentROW = 1
  957.          GOSUB GetLastpage
  958.          GOSUB Displaykeys
  959.  
  960.          CASE 79  'End
  961.  
  962.          IF Startpos >= height THEN
  963.             CurrentROW = 1
  964.             GOSUB endkeys
  965.             GOSUB Displaykeys
  966.          END IF
  967.  
  968.          CASE 80  'Down Arrow
  969.  
  970.          CurrentROW = CurrentROW + 1
  971.  
  972.          IF CurrentROW > height THEN
  973.             CurrentROW = CurrentROW - 1
  974.  
  975.             IF TEMPretcode(height) <> 0 THEN
  976.                key$ = DispLine$(height)
  977.                pnt = INSTR(DispLine$(CurrentROW)," ")
  978.                key$ = LEFT$(DispLine$(CurrentROW), pnt)
  979.                trim key$
  980.  
  981.                ISM "GE", indexnum, retcode
  982.                'IndexNext
  983.                ISM "N", indexnum, retcode
  984.  
  985.                IF retcode <> 0 THEN
  986.  
  987.                      FOR lineNum = 1 TO height - 1
  988.                         TEMPretcode(lineNum) = TEMPretcode(lineNum + 1)
  989.                         DispLine$(lineNum) = DispLine$(lineNum + 1)
  990.                      NEXT lineNum
  991.  
  992.                      GOSUB getreinfo
  993.                      DispLine$(height) = DispLine$
  994.  
  995.                      TEMPretcode(height) = retcode
  996.  
  997.                END IF
  998.  
  999.             END IF
  1000.  
  1001.             ELSE
  1002.  
  1003.             IF TEMPretcode(CurrentROW) = 0 THEN
  1004.                CurrentROW = CurrentROW - 1
  1005.             END IF
  1006.  
  1007.          END IF
  1008.  
  1009.          GOSUB Displaykeys
  1010.          CASE 72  'Up Arrow
  1011.          CurrentROW = CurrentROW - 1
  1012.  
  1013.          IF CurrentROW < 1 THEN
  1014.             CurrentROW = CurrentROW + 1
  1015.  
  1016.                key$ = DispLine$(1)
  1017.                pnt = INSTR(DispLine$(1)," ")
  1018.                key$ = LEFT$(DispLine$(1), pnt)
  1019.                trim key$
  1020.  
  1021.                ISM "GE", indexnum, retcode
  1022.  
  1023.                retcode = TEMPretcode(1)
  1024.                Prevretcode = retcode
  1025.                'IndexPrevious
  1026.  
  1027.                ISM "P", indexnum, retcode
  1028.  
  1029.                IF retcode <> 0 THEN
  1030.  
  1031.                      FOR lineNum = height TO 2 STEP -1
  1032.                         TEMPretcode(lineNum) = TEMPretcode(lineNum - 1)
  1033.                         DispLine$(lineNum) = DispLine$(lineNum - 1)
  1034.                      NEXT lineNum
  1035.  
  1036.                      GOSUB getreinfo
  1037.                      DispLine$(1) = DispLine$
  1038.                      TEMPretcode(1) = retcode
  1039.  
  1040.                END IF
  1041.  
  1042.             ELSE
  1043.  
  1044.             IF TEMPretcode(CurrentROW) = 0 THEN
  1045.                CurrentROW = CurrentROW + 1
  1046.             END IF
  1047.  
  1048.          END IF
  1049.  
  1050.          GOSUB Displaykeys
  1051.          CASE ELSE
  1052.          END SELECT
  1053.       END IF
  1054.  
  1055.       LOOP
  1056.       'Restore Screen
  1057.       PutBackground ROW, col, buf$
  1058.       buf$ = ""
  1059.       EXIT SUB
  1060. Displaykeys:
  1061.  
  1062.       FOR lineNum = 1 TO height
  1063.          Acc$ = DispLine$(lineNum)
  1064.  
  1065.          IF LEN(Acc$) < Dwidth2 THEN
  1066.             Acc$ = Acc$ + STRING$(Dwidth2 - LEN(Acc$), 32)
  1067.          END IF
  1068.  
  1069.          Crow = ROW + lineNum
  1070.          pnc Acc$, Crow, Ccol, Nf, Nb
  1071.       NEXT lineNum
  1072.  
  1073.       Startpos = lineNum
  1074.       RETURN
  1075. homekeys:
  1076.  
  1077.       FOR lineNum = 1 TO height
  1078.  
  1079.          TEMPretcode(lineNum) = 0
  1080.  
  1081.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1082.       NEXT lineNum
  1083.  
  1084.       ISM "F", indexnum, retcode
  1085.  
  1086.       IF retcode THEN
  1087.          GOSUB getreinfo
  1088.          DispLine$(1) = DispLine$
  1089.          TEMPretcode(1) = retcode
  1090.       END IF
  1091.  
  1092.  
  1093.       Prevretcode = retcode
  1094.       CurrentROW = 1
  1095. GetNextten:
  1096.  
  1097.       FOR lineNum = 2 TO height
  1098.  
  1099.          TEMPretcode(lineNum) = 0
  1100.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1101.       NEXT lineNum
  1102.  
  1103.  
  1104.       FOR lineNum = 2 TO height
  1105.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1106.  
  1107.          TEMPretcode(lineNum) = 0
  1108.          ISM "N", indexnum, retcode
  1109.  
  1110.          IF retcode > 0 THEN
  1111.  
  1112.             IF EOF(indexnum) THEN
  1113.                EXIT FOR
  1114.                ELSE
  1115.                GOSUB getreinfo
  1116.                DispLine$(lineNum) = DispLine$
  1117.                TEMPretcode(lineNum) = retcode
  1118.                Prevretcode = retcode
  1119.             END IF
  1120.             ELSE
  1121.             EXIT FOR
  1122.          END IF
  1123.  
  1124.       NEXT lineNum
  1125.       RETURN
  1126. endkeys:
  1127.  
  1128.       dsppos = 1
  1129.  
  1130.       FOR lineNum = 1 TO height
  1131.          TEMPretcode(lineNum) = 0
  1132.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1133.       NEXT lineNum
  1134.  
  1135.       ISM "L", indexnum, retcode
  1136.  
  1137.       IF retcode THEN
  1138.          GOSUB getreinfo
  1139.          DispLine$(height) = DispLine$
  1140.          TEMPretcode(height) = retcode
  1141.       END IF
  1142.  
  1143.       Prevretcode = retcode
  1144.       CurrentROW = 1
  1145.  
  1146. GetPreviousten:
  1147.  
  1148.       FOR lineNum = 1 TO height - 1
  1149.          TEMPretcode(lineNum) = 0
  1150.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1151.       NEXT lineNum
  1152.  
  1153.       Startpos = 1
  1154.  
  1155.       FOR lineNum = height - 1 TO 1 STEP -1
  1156.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1157.          ISM "P", indexnum, retcode
  1158.  
  1159.          IF retcode > 0 THEN
  1160.  
  1161.             IF EOF(indexnum) THEN
  1162.                EXIT FOR
  1163.                ELSE
  1164.                Startpos = Startpos + 1
  1165.                GOSUB getreinfo
  1166.                DispLine$(lineNum) = DispLine$
  1167.                TEMPretcode(lineNum) = retcode
  1168.                Prevretcode = retcode
  1169.                startrpos = Startpos + 1
  1170.  
  1171.             END IF
  1172.             ELSE
  1173.             EXIT FOR
  1174.          END IF
  1175.  
  1176.       NEXT lineNum
  1177.  
  1178.       RETURN
  1179. Getnextpage:
  1180.       key$ = DispLine$(height)
  1181.  
  1182.  
  1183.       FOR lineNum = 1 TO 2
  1184.           TEMPretcode(lineNum) = 0
  1185.           DispLine$(lineNum) = STRING$(KeyLen, 32)
  1186.       NEXT lineNum
  1187.  
  1188.       ISM "N", indexnum, retcode
  1189.  
  1190.       IF retcode THEN
  1191.          GOSUB getreinfo
  1192.          DispLine$(1) = DispLine$
  1193.          TEMPretcode(1) = retcode
  1194.          ELSE
  1195.          GOTO endkeys
  1196.          RETURN
  1197.       END IF
  1198.  
  1199.       Prevretcode = retcode
  1200.       CurrentROW = 1
  1201.  
  1202. GetNextpg:
  1203.  
  1204.       FOR lineNum = 2 TO height
  1205.           TEMPretcode(lineNum) = 0
  1206.           DispLine$(lineNum) = STRING$(KeyLen, 32)
  1207.       NEXT lineNum
  1208.  
  1209.       FOR lineNum = 2 TO height
  1210.           DispLine$(lineNum) = STRING$(KeyLen, 32)
  1211.           TEMPretcode(lineNum) = 0
  1212.          'get Next record
  1213.           ISM "N", indexnum, retcode
  1214.  
  1215.          IF retcode > 0 THEN
  1216.  
  1217.             IF EOF(indexnum) THEN
  1218.                GOTO endkeys
  1219.                ELSE
  1220.                GOSUB getreinfo
  1221.                DispLine$(lineNum) = DispLine$
  1222.             END IF
  1223.             ELSE
  1224.             GOTO endkeys
  1225.          END IF
  1226.  
  1227.       NEXT lineNum
  1228.  
  1229.       RETURN
  1230.  
  1231. GetLastpage:
  1232.  
  1233.       key$ = DispLine$(1)
  1234.  
  1235.       FOR lineNum = 1 TO height
  1236.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1237.       NEXT lineNum
  1238.  
  1239.       ISM "P", indexnum, retcode
  1240.  
  1241.       IF retcode THEN
  1242.          GOSUB getreinfo
  1243.          DispLine$(height) = DispLine$
  1244.          ELSE
  1245.          GOTO homekeys
  1246.       END IF
  1247.  
  1248.       Prevretcode = retcode
  1249.       CurrentROW = 1
  1250.  
  1251. GetLastpg:
  1252.  
  1253.       FOR lineNum = 1 TO height - 1
  1254.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1255.       NEXT lineNum
  1256.  
  1257.       FOR lineNum = height - 1 TO 1 STEP -1
  1258.          DispLine$(lineNum) = STRING$(KeyLen, 32)
  1259.          ISM "P", indexnum, retcode
  1260.  
  1261.          IF retcode > 0 THEN
  1262.  
  1263.             IF EOF(indexnum) THEN
  1264.                GOTO homekeys
  1265.                ELSE
  1266.                GOSUB getreinfo
  1267.                DispLine$(lineNum) = DispLine$
  1268.             END IF
  1269.  
  1270.          END IF
  1271.       NEXT lineNum
  1272.  
  1273.       RETURN
  1274. getreinfo:          'add if more than key RecField is displayed
  1275.  
  1276.       RETRIEVE indexnum, RecField
  1277.                dl$ =  userSformat((RTRIM$(RecField.LASTNAME)),"@@@@@@@@@@@@@@") + " "
  1278.                dl$ = dl$ + userSformat((RTRIM$(RecField.FIRSTNAME)),"@@@@@@@@@@@@@@") + " "
  1279.                dl$ = dl$ + userSformat((RTRIM$(RecField.ADDRESS)),"##################################") + " "
  1280.                dl$ = dl$ + userSformat((RTRIM$(RecField.PHONE1)),"999-9999") + " "
  1281.                dl$ = dl$ + userSformat((RTRIM$(RecField.PHONE2)),"(999) 999-9999") + " "
  1282.                DispLine$ = LEFT$(Dl$,70)
  1283.  
  1284.       RETURN
  1285.    END SUB
  1286.