home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 101.img / QB45-1.ZIP / INDEX.BAS < prev    next >
BASIC Source File  |  1987-09-23  |  10KB  |  311 lines
  1. DEFINT A-Z
  2.  
  3. ' Define the symbolic constants used globally in the program:
  4. CONST FALSE = 0, TRUE = NOT FALSE
  5.  
  6. ' Define a record structure for random-file records:
  7. TYPE StockItem
  8.    PartNumber  AS STRING * 6
  9.    Description AS STRING * 20
  10.    UnitPrice   AS SINGLE
  11.    Quantity    AS INTEGER
  12. END TYPE
  13.  
  14. ' Define a record structure for each element of the index:
  15. TYPE IndexType
  16.    RecordNumber AS INTEGER
  17.    PartNumber   AS STRING * 6
  18. END TYPE
  19.  
  20. ' Declare procedures that will be called:
  21. DECLARE FUNCTION Filter$ (Prompt$)
  22. DECLARE FUNCTION FindRecord% (PartNumber$, RecordVar AS StockItem)
  23.  
  24. DECLARE SUB AddRecord (RecordVar AS StockItem)
  25. DECLARE SUB InputRecord (RecordVar AS StockItem)
  26. DECLARE SUB PrintRecord (RecordVar AS StockItem)
  27. DECLARE SUB SortIndex ()
  28. DECLARE SUB ShowPartNumbers ()
  29.  
  30. ' Define a buffer (using the StockItem type) and
  31. ' define & dimension the index array:
  32. DIM StockRecord AS StockItem, Index(1 TO 100) AS IndexType
  33.  
  34. ' Open the random-access file:
  35. OPEN "STOCK.DAT" FOR RANDOM AS #1 LEN = LEN(StockRecord)
  36.  
  37. ' Calculate number of records in the file:
  38. NumberOfRecords = LOF(1) \ LEN(StockRecord)
  39.  
  40. ' If there are records, read them and build the index:
  41. IF NumberOfRecords <> 0 THEN
  42.    FOR RecordNumber = 1 TO NumberOfRecords
  43.  
  44.       ' Read the data from a new record in the file:
  45.       GET #1, RecordNumber, StockRecord
  46.  
  47.       ' Place part number and record number in index:
  48.       Index(RecordNumber).RecordNumber = RecordNumber
  49.       Index(RecordNumber).PartNumber = StockRecord.PartNumber
  50.    NEXT
  51.  
  52.    SortIndex            ' Sort index in part-number order.
  53. END IF
  54.  
  55. DO                      ' Main-menu loop.
  56.    CLS
  57.    PRINT "(A)dd records."
  58.    PRINT "(L)ook up records."
  59.    PRINT "(Q)uit program."
  60.    PRINT
  61.    LOCATE , , 1
  62.    PRINT "Type your choice (A, L, or Q) here: ";
  63.  
  64.    ' Loop until user presses, A, L, or Q:
  65.    DO
  66.       Choice$ = UCASE$(INPUT$(1))
  67.    LOOP WHILE INSTR("ALQ", Choice$) = 0
  68.  
  69.    ' Branch according to choice:
  70.    SELECT CASE Choice$
  71.       CASE "A"
  72.          AddRecord StockRecord
  73.       CASE "L"
  74.          IF NumberOfRecords = 0 THEN
  75.             PRINT : PRINT "No records in file yet. ";
  76.             PRINT "Press any key to continue.";
  77.             Pause$ = INPUT$(1)
  78.          ELSE
  79.             InputRecord StockRecord
  80.          END IF
  81.       CASE "Q"          ' End program
  82.    END SELECT
  83. LOOP UNTIL Choice$ = "Q"
  84.  
  85. CLOSE #1                ' All done, close file and end.
  86. END
  87. '
  88. ' ======================== ADDRECORD =========================
  89. '  Adds records to the file from input typed at the keyboard.
  90. ' ============================================================
  91. '
  92. SUB AddRecord (RecordVar AS StockItem) STATIC
  93.    SHARED Index() AS IndexType, NumberOfRecords
  94.    DO
  95.       CLS
  96.       INPUT "Part Number: ", RecordVar.PartNumber
  97.       INPUT "Description: ", RecordVar.Description
  98.       RecordVar.UnitPrice = VAL(Filter$("Unit Price : "))
  99.       RecordVar.Quantity = VAL(Filter$("Quantity   : "))
  100.  
  101.       NumberOfRecords = NumberOfRecords + 1
  102.  
  103.       PUT #1, NumberOfRecords, RecordVar
  104.  
  105.       Index(NumberOfRecords).RecordNumber = NumberOfRecords
  106.       Index(NumberOfRecords).PartNumber = RecordVar.PartNumber
  107.       PRINT : PRINT "Add another? ";
  108.       OK$ = UCASE$(INPUT$(1))
  109.    LOOP WHILE OK$ = "Y"
  110.  
  111.    SortIndex            ' Re-sort index file.
  112. END SUB
  113. '
  114. ' ========================= FILTER ===========================
  115. '       Filters all non-numeric characters from a string
  116. '       and returns the filtered string.
  117. ' ============================================================
  118. '
  119. FUNCTION Filter$ (Prompt$) STATIC
  120.    ValTemp2$ = ""
  121.    PRINT Prompt$;                    ' Print the prompt passed.
  122.    INPUT "", ValTemp1$               ' Input a number as
  123.                                      ' a string.
  124.    StringLength = LEN(ValTemp1$)     ' Get the string's length.
  125.    FOR I% = 1 TO StringLength        ' Go through the string,
  126.       Char$ = MID$(ValTemp1$, I%, 1) ' one character at a time.
  127.  
  128.       ' Is the character a valid part of a number (i.e.,
  129.       ' a digit or a decimal point)?  If yes, add it to
  130.       ' the end of a new string:
  131.       IF INSTR(".0123456789", Char$) > 0 THEN
  132.          ValTemp2$ = ValTemp2$ + Char$
  133.  
  134.       ' Otherwise, check to see if it's a lowercase "l",
  135.       ' since users used to typewriters may enter a one
  136.       ' value that way:
  137.       ELSEIF Char$ = "l" THEN
  138.          ValTemp2$ = ValTemp2$ + "1" ' Change the "l" to a "1".
  139.       END IF
  140.    NEXT I%
  141.  
  142.    Filter$ = ValTemp2$           ' Return filtered string.
  143.  
  144. END FUNCTION
  145. '
  146. ' ======================= FINDRECORD =========================
  147. '     Uses a binary search to locate a record in the index.
  148. ' ============================================================
  149. '
  150. FUNCTION FindRecord% (Part$, RecordVar AS StockItem) STATIC
  151.    SHARED Index() AS IndexType, NumberOfRecords
  152.  
  153.    ' Set top and bottom bounds of search:
  154.    TopRecord = NumberOfRecords
  155.    BottomRecord = 1
  156.  
  157.    ' Search until top of range is less than bottom:
  158.    DO UNTIL (TopRecord < BottomRecord)
  159.  
  160.       ' Choose midpoint:
  161.       Midpoint = (TopRecord + BottomRecord) \ 2
  162.  
  163.       ' Test to see if it's the one wanted (RTRIM$() trims
  164.       ' trailing blanks from a fixed string):
  165.       Test$ = RTRIM$(Index(Midpoint).PartNumber)
  166.  
  167.       ' If it is, exit loop:
  168.       IF Test$ = Part$ THEN
  169.          EXIT DO
  170.  
  171.       ' Otherwise, if what we're looking for is greater,
  172.       ' move bottom up:
  173.       ELSEIF Part$ > Test$ THEN
  174.          BottomRecord = Midpoint + 1
  175.  
  176.       ' Otherwise, move the top down:
  177.       ELSE
  178.          TopRecord = Midpoint - 1
  179.       END IF
  180.    LOOP
  181.  
  182.    ' If part was found, get record from file using
  183.    ' pointer in index and set FindRecord% to TRUE:
  184.    IF Test$ = Part$ THEN
  185.       GET #1, Index(Midpoint).RecordNumber, RecordVar
  186.       FindRecord% = TRUE
  187.  
  188.    ' Otherwise, if part was not found, set FindRecord%
  189.    ' to FALSE:
  190.    ELSE
  191.       FindRecord% = FALSE
  192.    END IF
  193. END FUNCTION
  194. '
  195. ' ======================= INPUTRECORD ========================
  196. '    First, INPUTRECORD calls SHOWPARTNUMBERS, which
  197. '    prints a menu of part numbers on the top of the screen.
  198. '    Next, INPUTRECORD prompts the user to enter a part
  199. '    number. Finally, it calls the FINDRECORD and PRINTRECORD
  200. '    procedures to find and print the given record.
  201. ' ============================================================
  202. '
  203. SUB InputRecord (RecordVar AS StockItem) STATIC
  204.    CLS
  205.    ShowPartNumbers      ' Call the ShowPartNumbers SUB.
  206.  
  207.    ' Print data from specified records on the bottom
  208.    ' part of the screen:
  209.    DO
  210.       PRINT "Type a part number listed above ";
  211.       INPUT "(or Q to quit) and press <ENTER>: ", Part$
  212.       IF UCASE$(Part$) <> "Q" THEN
  213.          IF FindRecord(Part$, RecordVar) THEN
  214.             PrintRecord RecordVar
  215.          ELSE
  216.             PRINT "Part not found."
  217.          END IF
  218.       END IF
  219.       PRINT STRING$(40, "_")
  220.    LOOP WHILE UCASE$(Part$) <> "Q"
  221.  
  222.    VIEW PRINT   ' Restore the text viewport to entire screen.
  223. END SUB
  224. '
  225. ' ======================= PRINTRECORD ========================
  226. '                Prints a record on the screen
  227. ' ============================================================
  228. '
  229. SUB PrintRecord (RecordVar AS StockItem) STATIC
  230.    PRINT "Part Number: "; RecordVar.PartNumber
  231.    PRINT "Description: "; RecordVar.Description
  232.    PRINT USING "Unit Price :$$###.##"; RecordVar.UnitPrice
  233.    PRINT "Quantity   :"; RecordVar.Quantity
  234. END SUB
  235. '
  236. ' ===================== SHOWPARTNUMBERS ======================
  237. '  Prints an index of all the part numbers in the upper part
  238. '  of the screen.
  239. ' ============================================================
  240. '
  241. SUB ShowPartNumbers STATIC
  242.    SHARED Index() AS IndexType, NumberOfRecords
  243.  
  244.    CONST NUMCOLS = 8, COLWIDTH = 80 \ NUMCOLS
  245.  
  246.    ' At the top of the screen, print a menu indexing all
  247.    ' the part numbers for records in the file.  This menu is
  248.    ' printed in columns of equal length (except possibly the
  249.    ' last column, which may be shorter than the others):
  250.    ColumnLength = NumberOfRecords
  251.    DO WHILE ColumnLength MOD NUMCOLS
  252.       ColumnLength = ColumnLength + 1
  253.    LOOP
  254.    ColumnLength = ColumnLength \ NUMCOLS
  255.    Column = 1
  256.    RecordNumber = 1
  257.    DO UNTIL RecordNumber > NumberOfRecords
  258.       FOR Row = 1 TO ColumnLength
  259.          LOCATE Row, Column
  260.          PRINT Index(RecordNumber).PartNumber
  261.          RecordNumber = RecordNumber + 1
  262.          IF RecordNumber > NumberOfRecords THEN EXIT FOR
  263.       NEXT Row
  264.       Column = Column + COLWIDTH
  265.    LOOP
  266.  
  267.    LOCATE ColumnLength + 1, 1
  268.    PRINT STRING$(80, "_")       ' Print separator line.
  269.  
  270.    ' Scroll information about records below the part-number
  271.    ' menu (this way, the part numbers are not erased):
  272.    VIEW PRINT ColumnLength + 2 TO 24
  273. END SUB
  274. '
  275. ' ========================= SORTINDEX ========================
  276. '                Sorts the index by part number
  277. ' ============================================================
  278. '
  279. SUB SortIndex STATIC
  280.    SHARED Index() AS IndexType, NumberOfRecords
  281.  
  282.    ' Set comparison offset to half the number of records
  283.    ' in index:
  284.    Offset = NumberOfRecords \ 2
  285.  
  286.    ' Loop until offset gets to zero:
  287.    DO WHILE Offset > 0
  288.       Limit = NumberOfRecords - Offset
  289.       DO
  290.  
  291.          ' Assume no switches at this offset:
  292.          Switch = FALSE
  293.  
  294.          ' Compare elements and switch ones out of order:
  295.          FOR I = 1 TO Limit
  296.             IF Index(I).PartNumber > Index(I + Offset).PartNumber THEN
  297.                SWAP Index(I), Index(I + Offset)
  298.                Switch = I
  299.             END IF
  300.          NEXT I
  301.  
  302.          ' Sort on next pass only to where last
  303.          ' switch was made:
  304.          Limit = Switch
  305.       LOOP WHILE Switch
  306.  
  307.       ' No switches at last offset, try one half as big:
  308.       Offset = Offset \ 2
  309.    LOOP
  310. END SUB
  311.