home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l196 / 1.ddi / ISAMDEMO.BA$ / ISAMDEMO.bin
Encoding:
Text File  |  1990-06-24  |  21.3 KB  |  737 lines
  1. '       ISAMDEMO.BAS - Main module of ISAM demonstration program
  2. '
  3. '           Copyright (C) 1989-1990, Microsoft Corporation
  4. '     
  5. '   This demo program uses BASIC 7.1's ISAM features along with its
  6. '   User Interface toolbox to implement a transaction database system.
  7. '   It consists of three modules (ISAMDEMO.BAS, ISAMDEM1.BAS and ISAMDEM2.BAS)
  8. '   and one include file (ISAMDEMO.BI).
  9. '
  10. '   A sample data file "AMAZRAYS.DAT" is provided with this demo.  An ISAM
  11. '   database file must be created from it.  This is done by selecting
  12. '   the "Create Sample Database" option from the File menu.  The sample
  13. '   data file must be located in the current directory (i.e. the directory
  14. '   appearing in the File.Open dialog).
  15. '   NOTE: The sample data provided with this demo is entirely fictitious.
  16. '
  17. '   The PROISAMD.EXE TSR must be installed before the ISAMDEMO can be
  18. '   be run.  If you do NOT have expanded memory available, you should
  19. '   invoke PROISAMD.EXE with the /Ib:n option, where n should be between
  20. '   15-20.  The /Ib: option specifies the number of buffers ISAM needs.
  21. '   Higher n values improve performance. Too few buffers, and the program
  22. '   will fail with an "Insufficient ISAM buffers" error.  If you do HAVE
  23. '   expanded memory, ISAM automatically uses up to 1.2 megabytes, even if
  24. '   you set Ib: to a low value.
  25. '
  26. '   EMS is needed to load and run the demo under QBX.  If you do not
  27. '   have EMS, refer to the command line compile instructions below which
  28. '   will allow you to run the demo from the DOS prompt.  To run the
  29. '   demo under QBX requires a combination QuickLib consisting of
  30. '   UITBEFR.LIB and DTFMTER.LIB.  This is created as follows:
  31. '           LIB isamdem.lib + uitbefr.lib + dtfmter.lib;
  32. '           LINK /Q isamdem.lib, isamdem.qlb,,qbxqlb.lib;
  33. '   Once created, just start QBX with this QuickLib and load the
  34. '   demo's modules (isamdemo.bas, isamdem1.bas and isamdem2.bas).
  35. '
  36. '   To create a compiled version of the isam demo perform the
  37. '   following steps:
  38. '       LIB isamdem.lib + uitbefr.lib + dtfmter.lib;
  39. '       BC /O/X/FS isamdemo.bas;
  40. '       BC /O/X/FS isamdem1.bas;
  41. '       BC /O/X/FS isamdem2.bas;
  42. '       LINK /EX isamdemo isamdem1 isamdem2, isamdemo.exe,, isamdem.lib;
  43. '   "ISAMDEMO" can now be run from the command line.
  44.  
  45. DEFINT A-Z
  46. '$INCLUDE: 'isamdemo.bi'
  47.  
  48. DECLARE SUB HandleMenuEvent ()
  49. DECLARE SUB CreateTranList (text$(), cBox AS ANY)
  50. DECLARE SUB BuildSampDB ()
  51.  
  52. 'definitions for UI toolbox
  53. DIM GloTitle(MAXMENU)           AS MenuTitleType
  54. DIM GloItem(MAXMENU, MAXITEM)   AS MenuItemType
  55. DIM GloWindow(MAXWINDOW)        AS windowType
  56. DIM GloButton(MAXBUTTON)        AS buttonType
  57. DIM GloEdit(30)                 AS EditFieldType
  58. DIM GloWindowStack(MAXWINDOW)   AS INTEGER
  59. DIM GloBuffer$(MAXWINDOW + 1, 2)
  60.  
  61.     STACK 10000                            'increase stack size
  62.  
  63.     ON ERROR GOTO GlobErr                  'global error handling
  64.  
  65.     InitAll                                'initialize program
  66.  
  67.     finished = FALSE                       'main control loop
  68.     WHILE NOT finished
  69.         kbd$ = MenuInkey$
  70.         WHILE MenuCheck(2)
  71.             HandleMenuEvent                    'handle menu selection
  72.         WEND
  73.     WEND
  74.  
  75.     END
  76.  
  77. GlobErr:
  78.     ShowError ERR                          'display error message
  79. RESUME NEXT
  80.  
  81. ' BuildSampDB
  82. ' Builds sample database from AMAZRAYS.DAT data file provided on the
  83. ' distribution disks.  Data file must be located in current directory
  84. ' for operation to succeed.
  85. '
  86. SUB BuildSampDB
  87.     ON LOCAL ERROR GOTO BuildErr
  88.  
  89.     temp$ = "amazrays.mdb"                'sample database file to create
  90.     IF LEN(DIR$(temp$)) = 0 THEN          'if file not exists, then create it
  91.         CLOSE
  92.         filenum = FREEFILE
  93.         temp2$ = "amazrays.dat"             'sample data file
  94.         OPEN temp2$ FOR INPUT AS filenum
  95.  
  96.         'inform user that database is being built
  97.         WindowOpen 1, 9, 18, 10, 60, 0, 7, 0, 7, 15, FALSE, FALSE, FALSE, TRUE, 1, ""
  98.         WindowLocate 1, 5
  99.         WindowPrint -2, "Creating ISAM file 'AMAZRAYS.MDB'"
  100.         WindowLocate 2, 5
  101.         WindowPrint -2, "Creating tables..."
  102.  
  103.         'create ISAM tables
  104.         CustTabNum = FREEFILE
  105.         OPEN temp$ FOR ISAM CustRecord "CustTable" AS CustTabNum
  106.         InveTabNum = FREEFILE
  107.         OPEN temp$ FOR ISAM InventRecord "InventTable" AS InveTabNum
  108.         InvoTabNum = FREEFILE
  109.         OPEN temp$ FOR ISAM InvoiceRecord "InvoiceTable" AS InvoTabNum
  110.         TranTabNum = FREEFILE
  111.         OPEN temp$ FOR ISAM TransRecord "TransTable" AS TranTabNum
  112.  
  113.         CreateIndexes                       'create table indexes
  114.  
  115.         'read information in from data file
  116.         WindowLocate 2, 5
  117.         WindowPrint -2, "Reading data...           "
  118.         INPUT #filenum, num
  119.         FOR i = 1 TO num
  120.             INPUT #filenum, CustRec.AcctNo, CustRec.Company, CustRec.Street, CustRec.City, CustRec.state, CustRec.Zip, CustRec.Phone1, CustRec.Phone2, CustRec.Contact, CustRec.Opened
  121.             INSERT CustTabNum, CustRec
  122.         NEXT i
  123.  
  124.         INPUT #filenum, num
  125.         FOR i = 1 TO num
  126.             INPUT #filenum, InventRec.ItemNo, InventRec.Descrip, InventRec.Cost, InventRec.Retail, InventRec.stock, InventRec.Vendor
  127.             INSERT InveTabNum, InventRec
  128.         NEXT i
  129.  
  130.         INPUT #filenum, num
  131.         FOR i = 1 TO num
  132.             INPUT #filenum, InvoiceRec.InvoiceNo, InvoiceRec.Date, InvoiceRec.AcctNo, InvoiceRec.TaxRate, InvoiceRec.Total
  133.             INSERT InvoTabNum, InvoiceRec
  134.         NEXT i
  135.  
  136.         INPUT #filenum, num
  137.         FOR i = 1 TO num
  138.             INPUT #filenum, TransRec.TransNo, TransRec.InvoiceNo, TransRec.ItemNo, TransRec.Quantity, TransRec.Price
  139.             INSERT TranTabNum, TransRec
  140.         NEXT i
  141.  
  142.         CLOSE
  143.         WindowClose 1
  144.         CustTabNum = 0
  145.         InveTabNum = 0
  146.         InvoTabNum = 0
  147.         TranTabNum = 0
  148.     ELSE
  149.         PrintError "AMAZRAYS.MDB already exists in current directory."
  150.     END IF
  151.  
  152.     EXIT SUB
  153.  
  154. BuildErr:
  155.     IF ERR = 53 THEN
  156.         temp$ = "Sample data file AMAZRAYS.DAT not found in " + CURDIR$
  157.         PrintError temp$
  158.         EXIT SUB
  159.     ELSE
  160.         ShowError ERR
  161.         IF ERR = 55 OR ERR = 10 OR ERR = 73 THEN
  162.             WindowClose 1
  163.             EXIT SUB
  164.         END IF
  165.     END IF
  166. RESUME NEXT
  167. END SUB
  168.  
  169. ' CreateCInvList
  170. ' Creates list of a customer's invoices to be displayed within a list box
  171. '
  172. ' text$() - list
  173. ' cBox - list box
  174. ' oBox - original list box
  175. ' barpos - scroll bar position
  176. '
  177. SUB CreateCInvList (text$(), cBox AS ListBox, oBox AS ListBox, barpos)
  178.  
  179.     IF cBox.curTop <> oBox.curTop THEN          'if list contents changed
  180.         GOSUB GetFirstCDateRecord
  181.  
  182.         First$ = text$(1)
  183.         FOR i = 1 TO cBox.bLen                  'get new list contents
  184.             IF EOF(InvoTabNum) THEN
  185.                 FOR j = i TO cBox.bLen
  186.                         text$(j) = ""
  187.                     NEXT j
  188.                     EXIT FOR
  189.             END IF
  190.             RETRIEVE InvoTabNum, InvoiceRec
  191.             IF UCASE$(InvoiceRec.Date) >= Bound2$ OR InvoiceRec.AcctNo <> CustRec.AcctNo THEN
  192.                 MOVELAST InvoTabNum
  193.                 text$(i) = ""
  194.             ELSE
  195.                 text$(i) = " " + MID$(InvoiceRec.Date, 3, 2) + "-" + MID$(InvoiceRec.Date, 5, 2) + "-" + MID$(InvoiceRec.Date, 1, 2)
  196.                 text$(i) = text$(i) + "     " + InvoiceRec.InvoiceNo + "    " + RIGHT$("             " + FormatS$(InvoiceRec.Total, "$#,##0.00"), 14)
  197.             END IF
  198.             MOVENEXT InvoTabNum
  199.         NEXT i
  200.  
  201.         IF text$(cBox.bLen) = "" AND cBox.curTop > 1 THEN
  202.             barpos = cBox.bLen - 2
  203.             cBox.curTop = oBox.curTop
  204.             cBox.curPos = oBox.curPos
  205.             FOR i = cBox.bLen TO 2 STEP -1
  206.                 text$(i) = text$(i - 1)
  207.             NEXT i
  208.             text$(1) = First$
  209.         END IF
  210.         temp$ = MID$(text$(1), 2, 8)
  211.         temp$ = MID$(temp$, 7, 2) + MID$(temp$, 1, 2) + MID$(temp$, 4, 2)
  212.         SEEKEQ InvoTabNum, CustRec.AcctNo, temp$, MID$(text$(1), 15, 6)
  213.     ELSEIF text$(cBox.bLen) = "" THEN           'if list smaller than box
  214.         IF cBox.curTop = 1 THEN barpos = 1
  215.         FOR i = 1 TO cBox.bLen                  'adjust position
  216.             IF text$(i) = "" AND cBox.curPos >= i THEN
  217.                 cBox.curPos = i - 1
  218.                 EXIT FOR
  219.             END IF
  220.         NEXT i
  221.     END IF
  222.  
  223.     EXIT SUB
  224.  
  225. 'get first record to display in list
  226. GetFirstCDateRecord:
  227.     IF cBox.curTop = 1 THEN                     'if top of list then first record
  228.         barpos = 1
  229.         SEEKGE InvoTabNum, CustRec.AcctNo, Bound1$, "0"
  230.     ELSEIF cBox.curTop + cBox.curPos - 1 = 9999 THEN    ' if bottom of list then start with
  231.                                                         ' last record and work up
  232.         SEEKGE InvoTabNum, CustRec.AcctNo, Bound2$, "0"
  233.         cBox.curPos = cBox.bLen
  234.         FOR i = 1 TO cBox.bLen
  235.             MOVEPREVIOUS InvoTabNum
  236.             IF BOF(InvoTabNum) THEN
  237.                 MOVEFIRST InvoTabNum
  238.                 cBox.curTop = 1
  239.                 cBox.curPos = i - 1
  240.                 EXIT FOR
  241.             ELSE
  242.                 RETRIEVE InvoTabNum, InvoiceRec
  243.                 IF UCASE$(InvoiceRec.Date) < Bound1$ OR InvoiceRec.AcctNo <> CustRec.AcctNo$ THEN
  244.                     cBox.curTop = 1
  245.                     cBox.curPos = i - 1
  246.                     MOVENEXT InvoTabNum
  247.                     EXIT FOR
  248.                 END IF
  249.             END IF
  250.         NEXT i
  251.         barpos = cBox.bLen - 2
  252.     ELSE                                        'determine position in database
  253.         IF cBox.curTop < oBox.curTop THEN
  254.             MOVEPREVIOUS InvoTabNum
  255.             IF BOF(InvoTabNum) THEN
  256.                 barpos = 1
  257.                 cBox.curTop = 1
  258.                 MOVEFIRST InvoTabNum
  259.             ELSE
  260.                 barpos = Max(barpos - 1, 1)
  261.                 RETRIEVE InvoTabNum, InvoiceRec
  262.                 IF UCASE$(InvoiceRec.Date) < Bound1$ OR InvoiceRec.AcctNo <> CustRec.AcctNo THEN
  263.                     MOVENEXT InvoTabNum
  264.                 END IF
  265.             END IF
  266.         ELSEIF cBox.curTop > oBox.curTop THEN
  267.             MOVENEXT InvoTabNum
  268.             IF EOF(InvoTabNum) THEN
  269.                 barpos = cBox.bLen - 2
  270.                 cBox.curTop = oBox.curTop
  271.                 MOVELAST InvoTabNum
  272.             ELSE
  273.                 barpos = Min(barpos + 1, cBox.bLen - 2)
  274.                 RETRIEVE InvoTabNum, InvoiceRec
  275.                 IF UCASE$(InvoiceRec.Date) > Bound2$ OR InvoiceRec.AcctNo <> CustRec.AcctNo THEN
  276.                     MOVEPREVIOUS InvoTabNum
  277.                 END IF
  278.             END IF
  279.         END IF
  280.     END IF
  281.  
  282. RETURN
  283.  
  284. END SUB
  285.  
  286. ' CreateCustList
  287. ' Creates list of a customers to be displayed within a list box
  288. '
  289. ' text$() - list
  290. ' cBox - list box
  291. ' oBox - original list box
  292. ' barpos - scroll bar position
  293. '
  294. SUB CreateCustList (text$(), cBox AS ListBox, oBox AS ListBox, barpos)
  295.     IF cBox.curTop <> oBox.curTop THEN          'if list contents changed
  296.         GOSUB GetFirstAlphaRecord
  297.  
  298.         First$ = text$(1)
  299.         FOR i = 1 TO cBox.bLen                  'get new list contents
  300.             IF EOF(CustTabNum) OR LOF(CustTabNum) = 0 THEN
  301.                 FOR j = i TO cBox.bLen
  302.                     text$(j) = ""
  303.                 NEXT j
  304.                 IF LOF(CustTabNum) = 0 THEN cBox.curPos = 0
  305.                 EXIT FOR
  306.             END IF
  307.             RETRIEVE CustTabNum, CustRec
  308.             IF UCASE$(MID$(CustRec.Company, 1, LEN(Bound2$))) >= Bound2$ THEN
  309.                 MOVELAST CustTabNum
  310.                 text$(i) = ""
  311.             ELSE
  312.                 text$(i) = " " + MID$(CustRec.Company, 1, 23) + "  " + CustRec.AcctNo + "        "
  313.                 text$(i) = text$(i) + MID$(CustRec.Opened, 3, 2) + "-" + MID$(CustRec.Opened, 5, 2) + "-" + MID$(CustRec.Opened, 1, 2)
  314.             END IF
  315.             MOVENEXT CustTabNum
  316.         NEXT i
  317.  
  318.         IF text$(cBox.bLen) = "" AND cBox.curTop > 1 THEN
  319.             barpos = cBox.bLen - 2
  320.             cBox.curTop = oBox.curTop
  321.             cBox.curPos = oBox.curPos
  322.             FOR i = cBox.bLen TO 2 STEP -1
  323.                 text$(i) = text$(i - 1)
  324.             NEXT i
  325.             text$(1) = First$
  326.         END IF
  327.         SEEKGE CustTabNum, MID$(text$(1), 2, 23), MID$(text$(1), 27, 5)
  328.     ELSEIF text$(cBox.bLen) = "" THEN
  329.         IF cBox.curTop = 1 THEN barpos = 1
  330.         FOR i = 1 TO cBox.bLen
  331.             IF text$(i) = "" AND cBox.curPos >= i THEN
  332.                 cBox.curPos = i - 1
  333.                 EXIT FOR
  334.             END IF
  335.         NEXT i
  336.     END IF
  337.     EXIT SUB
  338.  
  339. 'get first record to display in list
  340. GetFirstAlphaRecord:               
  341.     IF cBox.curTop = 1 THEN                     'if top of list then first record
  342.         SEEKGE CustTabNum, Bound1$, "0"
  343.         barpos = 1
  344.     ELSEIF cBox.curTop + cBox.curPos - 1 = 9999 THEN  'if bottom of list then start with
  345.                                                         'last record and work back
  346.         IF Bound2$ = "[" THEN
  347.             MOVELAST CustTabNum
  348.             MOVENEXT CustTabNum
  349.         ELSE
  350.             SEEKGE CustTabNum, Bound2$, "0"
  351.         END IF
  352.         cBox.curPos = cBox.bLen
  353.         FOR i = 1 TO cBox.bLen
  354.             MOVEPREVIOUS CustTabNum
  355.             IF BOF(CustTabNum) THEN
  356.                 MOVEFIRST CustTabNum
  357.                 cBox.curTop = 1
  358.                 cBox.curPos = i - 1
  359.                 EXIT FOR
  360.             ELSE
  361.                 RETRIEVE CustTabNum, CustRec
  362.                 IF UCASE$(MID$(CustRec.Company, 1, LEN(Bound1$))) < Bound1$ THEN
  363.                     cBox.curTop = 1
  364.                     cBox.curPos = i - 1
  365.                     MOVENEXT CustTabNum
  366.                     EXIT FOR
  367.                 END IF
  368.             END IF
  369.         NEXT i
  370.         barpos = cBox.bLen - 2
  371.     ELSE                                        'determine position in database
  372.         IF cBox.curTop < oBox.curTop THEN
  373.             MOVEPREVIOUS CustTabNum
  374.             IF BOF(CustTabNum) THEN
  375.                 barpos = 1
  376.                 cBox.curTop = 1
  377.                 MOVEFIRST CustTabNum
  378.             ELSE
  379.                 barpos = Max(barpos - 1, 1)
  380.                 RETRIEVE CustTabNum, CustRec
  381.                 IF UCASE$(MID$(CustRec.Company, 1, LEN(Bound1$))) < Bound1$ THEN
  382.                     MOVENEXT CustTabNum
  383.                 END IF
  384.             END IF
  385.         ELSEIF cBox.curTop > oBox.curTop THEN
  386.             MOVENEXT CustTabNum
  387.             IF EOF(CustTabNum) THEN
  388.                 barpos = cBox.bLen - 2
  389.                 cBox.curTop = oBox.curTop
  390.                 MOVELAST CustTabNum
  391.             ELSE
  392.                 barpos = Min(cBox.bLen - 2, barpos + 1)
  393.                 RETRIEVE CustTabNum, CustRec
  394.                 IF UCASE$(MID$(CustRec.Company, 1, LEN(Bound2$))) > Bound2$ THEN
  395.                     MOVEPREVIOUS CustTabNum
  396.                 END IF
  397.             END IF
  398.         END IF
  399.     END IF
  400.  
  401. RETURN
  402.  
  403. END SUB
  404.  
  405. ' CreateIndexes
  406. ' Creates indexes for any new ISAM tables created in the demo
  407. '
  408. SUB CreateIndexes
  409.     WindowLocate 2, 5
  410.     WindowPrint -2, "Creating table indexes..."
  411.     CREATEINDEX CustTabNum, "AcctIndex", TRUE, "AcctNo"
  412.     CREATEINDEX CustTabNum, "CompanyIndex", TRUE, "Company", "AcctNo"
  413.     CREATEINDEX InveTabNum, "ItemIndex", TRUE, "ItemNo"
  414.     CREATEINDEX InvoTabNum, "InvoiceIndex", TRUE, "InvoiceNo"
  415.     CREATEINDEX InvoTabNum, "DateIndex", TRUE, "Date", "InvoiceNo"
  416.     CREATEINDEX InvoTabNum, "InvAcctIndex", TRUE, "AcctNo", "Date", "InvoiceNo"
  417.     CREATEINDEX TranTabNum, "TransInvIndex", TRUE, "InvoiceNo", "TransNo"
  418. END SUB
  419.  
  420. ' CreateInveList
  421. ' Creates list of a inventory items to be displayed within a list box
  422. '
  423. ' text$() - list
  424. ' cBox - list box
  425. ' oBox - original list box
  426. ' barpos - scroll bar position
  427. '
  428. SUB CreateInveList (text$(), cBox AS ListBox, oBox AS ListBox, barpos)
  429.     IF cBox.curTop <> oBox.curTop THEN          'if list contents changed
  430.         GOSUB GetFirstPhysRecord
  431.  
  432.         First$ = text$(1)
  433.         FOR i = 1 TO cBox.bLen                  'get new list contents
  434.             IF EOF(InveTabNum) OR LOF(InveTabNum) = 0 THEN
  435.                 FOR j = i TO cBox.bLen
  436.                     text$(j) = ""
  437.                 NEXT j
  438.                 IF LOF(InveTabNum) = 0 THEN cBox.curPos = 0
  439.                 EXIT FOR
  440.             END IF
  441.             RETRIEVE InveTabNum, InventRec
  442.             text$(i) = " " + InventRec.ItemNo + "   " + MID$(InventRec.Descrip, 1, 24) + "  " + RIGHT$("     " + STR$(InventRec.stock), 5)
  443.             text$(i) = text$(i) + "  " + RIGHT$("          " + FormatS$(InventRec.Cost, "$#,##0.00"), 11) + "  " + RIGHT$("          " + FormatS$(InventRec.Retail, "$#,##0.00"), 11)
  444.             MOVENEXT InveTabNum
  445.         NEXT i
  446.  
  447.         IF text$(cBox.bLen) = "" AND cBox.curTop > 1 THEN
  448.             barpos = cBox.bLen - 2
  449.             cBox.curPos = oBox.curPos
  450.             cBox.curTop = oBox.curTop
  451.             FOR i = cBox.bLen TO 2 STEP -1
  452.                 text$(i) = text$(i - 1)
  453.             NEXT i
  454.             text$(1) = First$
  455.         END IF
  456.         SEEKEQ InveTabNum, MID$(text$(1), 2, 5)
  457.     ELSEIF text$(cBox.bLen) = "" THEN
  458.         IF cBox.curTop = 1 THEN barpos = 1
  459.         FOR i = 1 TO cBox.bLen
  460.             IF text$(i) = "" AND cBox.curPos >= i THEN
  461.                 cBox.curPos = i - 1
  462.                 EXIT FOR
  463.             END IF
  464.         NEXT i
  465.     END IF
  466.  
  467.     EXIT SUB
  468.  
  469. 'get first record to display in list
  470. GetFirstPhysRecord:
  471.     IF cBox.curTop = 1 THEN                     'if top of list then first record
  472.         MOVEFIRST InveTabNum
  473.         barpos = 1
  474.     ELSEIF cBox.curTop + cBox.curPos - 1 = 9999 THEN  'if bottom of list then start with
  475.                                                         'last record and work back
  476.         MOVELAST InveTabNum
  477.         cBox.curPos = cBox.bLen
  478.         FOR i = 1 TO cBox.bLen - 1
  479.             MOVEPREVIOUS InveTabNum
  480.             IF BOF(InveTabNum) THEN
  481.                 MOVEFIRST InveTabNum
  482.                 cBox.curTop = 1
  483.                 cBox.curPos = i
  484.                 EXIT FOR
  485.             END IF
  486.         NEXT i
  487.         barpos = cBox.bLen - 2
  488.     ELSE                                        'determine position in database
  489.         IF cBox.curTop < oBox.curTop THEN
  490.             barpos = Max(barpos - 1, 1)
  491.             MOVEPREVIOUS InveTabNum
  492.             IF BOF(InveTabNum) THEN
  493.                 cBox.curTop = 1
  494.                 MOVEFIRST InveTabNum
  495.                 barpos = 1
  496.             END IF
  497.         ELSEIF cBox.curTop > oBox.curTop THEN
  498.             barpos = Min(barpos + 1, cBox.bLen - 2)
  499.             MOVENEXT InveTabNum
  500.         END IF
  501.     END IF
  502. RETURN
  503.  
  504. END SUB
  505.  
  506. ' CreateInvoList
  507. ' Creates list of invoices to be displayed within a list box
  508. '
  509. ' text$() - list
  510. ' cBox - list box
  511. ' oBox - original list box
  512. ' barpos - scroll bar position
  513. '
  514. SUB CreateInvoList (text$(), cBox AS ListBox, oBox AS ListBox, barpos)
  515.     IF cBox.curTop <> oBox.curTop THEN          'if list contents changed
  516.         GOSUB GetFirstDateRecord
  517.  
  518.         First$ = text$(1)
  519.         FOR i = 1 TO cBox.bLen                  'get new list contents
  520.             IF EOF(InvoTabNum) THEN
  521.                 FOR j = i TO cBox.bLen
  522.                     text$(j) = ""
  523.                 NEXT j
  524.                 EXIT FOR
  525.             END IF
  526.             RETRIEVE InvoTabNum, InvoiceRec
  527.             IF UCASE$(InvoiceRec.Date) >= Bound2$ THEN
  528.                 MOVELAST InvoTabNum
  529.                 text$(i) = ""
  530.             ELSE
  531.                 text$(i) = " " + MID$(InvoiceRec.Date, 3, 2) + "-" + MID$(InvoiceRec.Date, 5, 2) + "-" + MID$(InvoiceRec.Date, 1, 2)
  532.                 text$(i) = text$(i) + "     " + InvoiceRec.InvoiceNo + "        " + InvoiceRec.AcctNo + "   " + RIGHT$("             " + FormatS$(InvoiceRec.Total, "$#,##0.00"), 14)
  533.             END IF
  534.             MOVENEXT InvoTabNum
  535.         NEXT i
  536.  
  537.         IF text$(cBox.bLen) = "" AND cBox.curTop > 1 THEN
  538.             barpos = cBox.bLen - 2
  539.             cBox.curTop = oBox.curTop
  540.             cBox.curPos = oBox.curPos
  541.             FOR i = cBox.bLen TO 2 STEP -1
  542.                 text$(i) = text$(i - 1)
  543.             NEXT i
  544.             text$(1) = First$
  545.         END IF
  546.         temp$ = MID$(text$(1), 2, 8)
  547.         temp$ = MID$(temp$, 7, 2) + MID$(temp$, 1, 2) + MID$(temp$, 4, 2)
  548.         SEEKEQ InvoTabNum, temp$, MID$(text$(1), 15, 6)
  549.     ELSEIF text$(cBox.bLen) = "" THEN
  550.         IF cBox.curTop = 1 THEN barpos = 1
  551.         FOR i = 1 TO cBox.bLen
  552.             IF text$(i) = "" AND cBox.curPos >= i THEN
  553.                 cBox.curPos = i - 1
  554.                 EXIT FOR
  555.                 END IF
  556.         NEXT i
  557.     END IF
  558.  
  559.     EXIT SUB
  560.  
  561. 'get first record to display in list
  562. GetFirstDateRecord:
  563.     IF cBox.curTop = 1 THEN                     'if top of list then first record
  564.         barpos = 1
  565.         SEEKGE InvoTabNum, Bound1$, "0"
  566.     ELSEIF cBox.curTop + cBox.curPos - 1 = 9999 THEN  'if bottom of list then start with
  567.                                                         'last record and work back
  568.         SEEKGE InvoTabNum, Bound2$, "0"
  569.         cBox.curPos = cBox.bLen
  570.         FOR i = 1 TO cBox.bLen
  571.             MOVEPREVIOUS InvoTabNum
  572.             IF BOF(InvoTabNum) THEN
  573.                 MOVEFIRST InvoTabNum
  574.                 cBox.curTop = 1
  575.                 cBox.curPos = i - 1
  576.                 EXIT FOR
  577.             ELSE
  578.                 RETRIEVE InvoTabNum, InvoiceRec
  579.                 IF UCASE$(InvoiceRec.Date) < Bound1$ THEN
  580.                     cBox.curTop = 1
  581.                     cBox.curPos = i - 1
  582.                     MOVENEXT InvoTabNum
  583.                     EXIT FOR
  584.                 END IF
  585.             END IF
  586.         NEXT i
  587.         barpos = cBox.bLen - 2                  'determine position in database
  588.     ELSE
  589.         IF cBox.curTop < oBox.curTop THEN
  590.             MOVEPREVIOUS InvoTabNum
  591.             IF BOF(InvoTabNum) THEN
  592.                 barpos = 1
  593.                 cBox.curTop = 1
  594.                 MOVEFIRST InvoTabNum
  595.             ELSE
  596.                 barpos = Max(barpos - 1, 1)
  597.                 RETRIEVE InvoTabNum, InvoiceRec
  598.                 IF UCASE$(InvoiceRec.Date) < Bound1$ THEN
  599.                     MOVENEXT InvoTabNum
  600.                 END IF
  601.             END IF
  602.         ELSEIF cBox.curTop > oBox.curTop THEN
  603.             MOVENEXT InvoTabNum
  604.             IF EOF(InvoTabNum) THEN
  605.                 barpos = cBox.bLen - 2
  606.                 cBox.curTop = oBox.curTop
  607.                 MOVELAST InvoTabNum
  608.             ELSE
  609.                 barpos = Min(barpos + 1, cBox.bLen - 2)
  610.                 RETRIEVE InvoTabNum, InvoiceRec
  611.                 IF UCASE$(InvoiceRec.Date) > Bound2$ THEN
  612.                     MOVEPREVIOUS InvoTabNum
  613.                 END IF
  614.             END IF
  615.         END IF
  616.     END IF
  617.  
  618. RETURN
  619.  
  620. END SUB
  621.  
  622. ' CreateTranList
  623. ' Creates list of an invoice's transactions to be displayed within a list box
  624. '
  625. ' text$() - list
  626. ' cBox - list box
  627. ' oBox - original list box
  628. ' barpos - scroll bar position
  629. '
  630. SUB CreateTranList (text$(), cBox AS ListBox)
  631.     SETINDEX TranTabNum, "TransInvIndex"
  632.     SEEKEQ TranTabNum, InvoiceRec.InvoiceNo, cBox.curTop
  633.     FOR i = 1 TO cBox.bLen
  634.         IF cBox.curTop + i - 1 < 10 THEN
  635.             sp$ = " "
  636.         ELSE
  637.             sp$ = ""
  638.         END IF
  639.         IF EOF(TranTabNum) THEN
  640.             text$(i) = sp$ + LTRIM$(STR$(cBox.curTop + i - 1)) + "."
  641.         ELSE
  642.             RETRIEVE TranTabNum, TransRec
  643.             IF TransRec.InvoiceNo <> InvoiceRec.InvoiceNo THEN
  644.                 text$(i) = sp$ + LTRIM$(STR$(cBox.curTop + i - 1)) + "."
  645.             ELSE
  646.                 text$(i) = sp$ + LTRIM$(STR$(cBox.curTop + i - 1)) + ". " + TransRec.ItemNo + "   " + RIGHT$("         " + FormatS$(TransRec.Price, "$#,##0.00"), 11) + "     "
  647.                 text$(i) = text$(i) + RIGHT$("   " + STR$(TransRec.Quantity), 5) + "  " + RIGHT$("         " + FormatS$(TransRec.Price * TransRec.Quantity, "$#,##0.00"), 14)
  648.             END IF
  649.             MOVENEXT TranTabNum
  650.         END IF
  651.     NEXT i
  652.  
  653. END SUB
  654.  
  655. ' HandleMenuEvent
  656. ' Determines the action to perform when user makes a menu selection.
  657. '
  658. SUB HandleMenuEvent
  659.     ON LOCAL ERROR GOTO HandleErr
  660.  
  661.     menu = MenuCheck(0)
  662.     item = MenuCheck(1)
  663.  
  664.     ' clear global records
  665.     ClearInveRecord
  666.     ClearCustRecord
  667.     ClearInvoRecord
  668.     ClearTranRecord
  669.  
  670.     SELECT CASE menu
  671.         ' file menu selection
  672.         CASE FILETITLE
  673.             SELECT CASE item
  674.                 ' create new ISAM file
  675.                 CASE 1: NewDB
  676.                 ' open existing ISAM file
  677.                 CASE 2: OpenDB
  678.                 ' build sample database
  679.                 CASE 4: BuildSampDB
  680.                 ' exit program
  681.                 CASE 6: Quit
  682.             END SELECT
  683.  
  684.         ' transaction menu selection
  685.         CASE TRANSTITLE
  686.             BEGINTRANS
  687.             SELECT CASE item
  688.                 ' purchase order
  689.                 CASE 1
  690.                     RunInvoice 1
  691.                 ' list of invoices
  692.                 CASE 2
  693.                     RunList 1, 5
  694.             END SELECT
  695.             COMMITTRANS
  696.  
  697.         ' customer menu selection
  698.         CASE CUSTTITLE
  699.             BEGINTRANS
  700.             SELECT CASE item
  701.                 ' customer record
  702.                 CASE 1
  703.                     level = 0
  704.                     RunCustRec 1
  705.                 ' list of customers
  706.                 CASE 2
  707.                     level = 0
  708.                     RunList 1, 3
  709.             END SELECT
  710.             COMMITTRANS
  711.  
  712.         ' inventory menu selection
  713.         CASE INVTITLE
  714.             BEGINTRANS
  715.             SELECT CASE item
  716.                 ' inventory record
  717.                 CASE 1
  718.                     level = 0
  719.                     RunInventRec 1
  720.                 ' list of inventory items
  721.                 CASE 2
  722.                     level = 0
  723.                     RunList 1, 2
  724.             END SELECT
  725.             COMMITTRANS
  726.     END SELECT
  727.  
  728.     EXIT SUB
  729.  
  730. HandleErr:
  731.     ShowError ERR
  732.     EXIT SUB
  733. RESUME NEXT
  734.  
  735. END SUB
  736.  
  737.