Microsoft Programmer's Library 1.3/Microsoft-Programers-Library-v1.3.iso/sampcode/basic/index.bas

BASIC Source File | 1989-11-09 | 9.0 KB | 306 lines

DEFINT A-Z

' Define the symbolic constants used globally in the program:
CONST FALSE = 0, TRUE = NOT FALSE

' Define a record structure for random-file records:
TYPE StockItem
    PartNumber AS STRING * 6
    Description AS STRING * 20
    UnitPrice AS SINGLE
    Quantity AS INTEGER
END TYPE

' Define a record structure for each element of the index:
TYPE IndexType
    RecordNumber AS INTEGER
    PartNumber AS STRING * 6
END TYPE

' Declare procedures that will be called:
DECLARE FUNCTION Filter$ (Prompt$)
DECLARE FUNCTION FindRecord% (PartNumber$, RecordVar AS StockItem)

DECLARE SUB AddRecord (RecordVar AS StockItem)
DECLARE SUB InputRecord (RecordVar AS StockItem)
DECLARE SUB PrintRecord (RecordVar AS StockItem)
DECLARE SUB SortIndex ()
DECLARE SUB ShowPartNumbers ()
' Define a buffer (using the StockItem type)
' and define and dimension the index array:
DIM StockRecord AS StockItem, index(1 TO 100) AS IndexType

' Open the random-access file:
OPEN "STOCK.DAT" FOR RANDOM AS #1 LEN = LEN(StockRecord)

' Calculate number of records in the file:
NumberOfRecords = LOF(1) \ LEN(StockRecord)

' If there are records, read them and build the index:
IF NumberOfRecords <> 0 THEN
    FOR RecordNumber = 1 TO NumberOfRecords

        ' Read the data from a new record in the file:
        GET #1, RecordNumber, StockRecord

        ' Place part number and record number in index:
        index(RecordNumber).RecordNumber = RecordNumber
        index(RecordNumber).PartNumber = StockRecord.PartNumber
    NEXT

    SortIndex            ' Sort index in part-number order.
END IF

DO                      ' Main-menu loop.
    CLS
    PRINT "(A)dd records."
    PRINT "(L)ook up records."
    PRINT "(Q)uit program."
    PRINT
    LOCATE , , 1
    PRINT "Type your choice (A, L, or Q) here: ";

    ' Loop until user presses, A, L, or Q:
    DO
        Choice$ = UCASE$(INPUT$(1))
    LOOP WHILE INSTR("ALQ", Choice$) = 0

    ' Branch according to choice:
    SELECT CASE Choice$
        CASE "A"
     AddRecord StockRecord
        CASE "L"
     IF NumberOfRecords = 0 THEN
         PRINT : PRINT "No records in file yet. ";
         PRINT "Press any key to continue.";
         Pause$ = INPUT$(1)
     ELSE
         InputRecord StockRecord
     END IF
        CASE "Q"          ' End program.
    END SELECT
LOOP UNTIL Choice$ = "Q"

CLOSE #1                ' All done, close file and end.
END
' ======================== ADDRECORD ======================
' Adds records to the file from input typed at the keyboard
' =========================================================
' ========================= FILTER ========================
'       Filters all non-numeric characters from a string
'       and returns the filtered string
' =========================================================
' ======================= FINDRECORD ===================
'  Uses a binary search to locate a record in the index
' ======================================================
' ======================= PRINTRECORD =====================
'                Prints a record on the screen
' =========================================================
' ===================== SHOWPARTNUMBERS ===================
' Prints an index of all the part numbers in the upper part
' of the screen
' =========================================================
' ========================= SORTINDEX =====================
'                Sorts the index by part number
' =========================================================


SUB AddRecord (RecordVar AS StockItem) STATIC
    SHARED index() AS IndexType, NumberOfRecords
    DO
        CLS
        INPUT "Part Number: ", RecordVar.PartNumber
        INPUT "Description: ", RecordVar.Description

        ' Call the Filter$ FUNCTION to input price & quantity:
        RecordVar.UnitPrice = VAL(Filter$("Unit Price : "))
        RecordVar.Quantity = VAL(Filter$("Quantity   : "))

        NumberOfRecords = NumberOfRecords + 1

        PUT #1, NumberOfRecords, RecordVar

        index(NumberOfRecords).RecordNumber = NumberOfRecords
        index(NumberOfRecords).PartNumber = RecordVar.PartNumber
        PRINT : PRINT "Add another? ";
        OK$ = UCASE$(INPUT$(1))
    LOOP WHILE OK$ = "Y"

    SortIndex            ' Sort index file again.
END SUB

FUNCTION Filter$ (Prompt$) STATIC
    ValTemp2$ = ""
    PRINT Prompt$;                    ' Print the prompt passed.
    INPUT "", ValTemp1$               ' Input a number as
                                                 ' a string.
    StringLength = LEN(ValTemp1$)     ' Get the string's length.
    FOR I% = 1 TO StringLength        ' Go through the string,
        Char$ = MID$(ValTemp1$, I%, 1) ' one character at a time.

        ' Is the character a valid part of a number (i.e.,
        ' a digit or a decimal point)?  If yes, add it to
        ' the end of a new string:
        IF INSTR(".0123456789", Char$) > 0 THEN
            ValTemp2$ = ValTemp2$ + Char$

        ' Otherwise, check to see if it's a lowercase "l",
        ' since typewriter users may enter a one that way:
        ELSEIF Char$ = "l" THEN
            ValTemp2$ = ValTemp2$ + "1" ' Change the "l" to a "1".
        END IF
    NEXT I%

    Filter$ = ValTemp2$               ' Return filtered string.

END FUNCTION

FUNCTION FindRecord% (Part$, RecordVar AS StockItem) STATIC
    SHARED index() AS IndexType, NumberOfRecords

    ' Set top and bottom bounds of search:
    TopRecord = NumberOfRecords
    BottomRecord = 1

    ' Search until top of range is less than bottom:
    DO UNTIL (TopRecord < BottomRecord)

        ' Choose midpoint:
        Midpoint = (TopRecord + BottomRecord) \ 2

        ' Test to see if it's the one wanted (RTRIM$()
        ' trims trailing blanks from a fixed string):
        Test$ = RTRIM$(index(Midpoint).PartNumber)

        ' If it is, exit loop:
        IF Test$ = Part$ THEN
     EXIT DO

        ' Otherwise, if what we're looking for is greater,
        ' move bottom up:
        ELSEIF Part$ > Test$ THEN
     BottomRecord = Midpoint + 1

        ' Otherwise, move the top down:
        ELSE
     TopRecord = Midpoint - 1
        END IF
    LOOP

    ' If part was found, input record from file using
    ' pointer in index and set FindRecord% to TRUE:
    IF Test$ = Part$ THEN
        GET #1, index(Midpoint).RecordNumber, RecordVar
        FindRecord% = TRUE

    ' Otherwise, if part was not found, set FindRecord%
    ' to FALSE:
    ELSE
        FindRecord% = FALSE
    END IF
END FUNCTION

' ======================= INPUTRECORD =====================
'    First, INPUTRECORD calls SHOWPARTNUMBERS, which prints
'    a menu of part numbers on the top of the screen. Next,
'    INPUTRECORD prompts the user to enter a part number.
'    Finally, it calls the FINDRECORD and PRINTRECORD
'    procedures to find and print the given record.
' =========================================================
SUB InputRecord (RecordVar AS StockItem) STATIC
    CLS
    ShowPartNumbers      ' Call the ShowPartNumbers SUB.

    ' Print data from specified records
    ' on the bottom part of the screen:
    DO
        PRINT "Type a part number listed above ";
        INPUT "(or Q to quit) and press <ENTER>: ", Part$
        IF UCASE$(Part$) <> "Q" THEN
     IF FindRecord(Part$, RecordVar) THEN
         PrintRecord RecordVar
     ELSE
         PRINT "Part not found."
     END IF
        END IF
        PRINT STRING$(40, "_")
    LOOP WHILE UCASE$(Part$) <> "Q"

    VIEW PRINT   ' Restore the text viewport to entire screen.
END SUB

SUB PrintRecord (RecordVar AS StockItem) STATIC
    PRINT "Part Number: "; RecordVar.PartNumber
    PRINT "Description: "; RecordVar.Description
    PRINT USING "Unit Price :$$###.##"; RecordVar.UnitPrice
    PRINT "Quantity   :"; RecordVar.Quantity
END SUB

SUB ShowPartNumbers STATIC
    SHARED index() AS IndexType, NumberOfRecords

    CONST NUMCOLS = 8, COLWIDTH = 80 \ NUMCOLS

    ' At the top of the screen, print a menu indexing all
    ' the part numbers for records in the file. This menu is
    ' printed in columns of equal length (except possibly the
    ' last column, which may be shorter than the others):
    ColumnLength = NumberOfRecords
    DO WHILE ColumnLength MOD NUMCOLS
        ColumnLength = ColumnLength + 1
    LOOP
    ColumnLength = ColumnLength \ NUMCOLS
    Column = 1
    RecordNumber = 1
DO UNTIL RecordNumber > NumberOfRecords
        FOR Row = 1 TO ColumnLength
     LOCATE Row, Column
     PRINT index(RecordNumber).PartNumber
     RecordNumber = RecordNumber + 1
     IF RecordNumber > NumberOfRecords THEN EXIT FOR
        NEXT Row
        Column = Column + COLWIDTH
    LOOP

    LOCATE ColumnLength + 1, 1
    PRINT STRING$(80, "_")       ' Print separator line.

    ' Scroll information about records below the part-number
    ' menu (this way, the part numbers are not erased):
    VIEW PRINT ColumnLength + 2 TO 24
END SUB

SUB SortIndex STATIC
    SHARED index() AS IndexType, NumberOfRecords

    ' Set comparison offset to half the number of records
    ' in index:
    Offset = NumberOfRecords \ 2

    ' Loop until offset gets to zero:
    DO WHILE Offset > 0
        Limit = NumberOfRecords - Offset
        DO

     ' Assume no switches at this offset:
     Switch = FALSE

     ' Compare elements and switch ones out of order:
     FOR I = 1 TO Limit
         IF index(I).PartNumber > index(I + Offset).PartNumber THEN
             SWAP index(I), index(I + Offset)
             Switch = I
         END IF
     NEXT I

     ' Sort on next pass only to where
     ' last switch was made:
     Limit = Switch
        LOOP WHILE Switch

        ' No switches at last offset, try one half as big:
        Offset = Offset \ 2
    LOOP
END SUB