Power-Programmierung/CD1.mdf/basic/library/qb_pds/papers/papers.bas

BASIC Source File | 1992-03-01 | 11.5 KB | 293 lines

' PAPERS.BAS

' A simple dedicated database program which keeps track of
' newspaper and pamphlet distribution contracts.

' This program is in the public domain.  The author accepts no
' liability for anything.

' Written by Matt McLeod ([e-mail], [e-mail])


DECLARE SUB PrintData ()
DECLARE SUB DrawScreen ()
DECLARE SUB DrawLine (row AS INTEGER)
DECLARE SUB GetContract ()
DECLARE SUB LoadData (filename AS STRING)

' Constants for boolean stuff

CONST true = -1, false = 0

' Datatype to hold date info

TYPE DateType
        Day AS INTEGER
        Month AS INTEGER
        Year AS INTEGER
END TYPE

' Datatyoe to hold contract info

TYPE ContractRec
        Number AS STRING * 6
        DateReceived AS DateType
        DatePayed AS DateType
        Amount AS SINGLE
END TYPE

' the main storage of data

DIM SHARED Contract(1 TO 1000) AS ContractRec

' a couple of miscellaneous variables

DIM SHARED TotalContracts AS INTEGER
DIM SHARED TopOfScreen AS INTEGER
DIM SHARED Current AS INTEGER

' and now the program...

CLS
INPUT "Filename: "; filename$
IF filename$ <> "" THEN LoadData (filename$)

' if no filename was entered, then no file is loaded.
' now a few initializations...

Done = false
TopOfScreen = 1
Current = 1
Redraw = true
DO
        IF Redraw THEN DrawScreen
        IF TotalContracts = 0 THEN
                GetContract
                DrawScreen
        END IF
        VIEW PRINT 5 TO 23
        IF Redraw THEN
                PrintData
        ELSE

                ' This bit handles only drawing a single line of data

                LOCATE Current - TopOfScreen + 5, 1
                COLOR 15
                PRINT Contract(Current).Number; TAB(20);
                PRINT USING "##/##/##"; Contract(Current).DateReceived.Day; Contract(Current).DateReceived.Month; Contract(Current).DateReceived.Year; TAB(32);
                IF Contract(Current).DatePayed.Day <> 0 THEN PRINT USING "##/##/##"; Contract(Current).DatePayed.Day; Contract(Current).DatePayed.Month; Contract(Current).DatePayed.Year;
                PRINT TAB(48);
                PRINT USING "$$,####.##"; Contract(Current).Amount
                COLOR 7
        END IF
        Redraw = true
        GotIt = false
        DO

        ' And now we do the big stuff...

                keyin$ = INKEY$
                SELECT CASE keyin$
                CASE "x"  ' X for eXit
                        GotIt = true
                        Done = true
                CASE "a"  ' A for Add data
                        GetContract
                        GotIt = true
                CASE "e"  ' E for Edit data
                        VIEW PRINT 25 TO 25
                        INPUT "Number: "; in$
                        IF in$ <> "" THEN Contract(Current).Number = in$
                        INPUT "Date Received:  "; in$
                        IF in$ <> "" THEN
                                Contract(Current).DateReceived.Year = VAL(RIGHT$(in$, 2))
                                Contract(Current).DateReceived.Month = VAL(MID$(in$, 4, 2))
                                Contract(Current).DateReceived.Day = VAL(LEFT$(in$, 2))
                        END IF
                        INPUT "Date Payed: "; in$
                        IF in$ <> "" THEN
                                Contract(Current).DatePayed.Year = VAL(RIGHT$(in$, 2))
                                Contract(Current).DatePayed.Month = VAL(MID$(in$, 4, 2))
                                Contract(Current).DatePayed.Day = VAL(LEFT$(in$, 2))
                        END IF
                        INPUT "Amount: "; in$
                        IF in$ <> "" THEN Contract(Current).Amount = VAL(in$)
                        GotIt = true
                CASE "s"  ' S for Save data
                        VIEW PRINT 25 TO 25
                        INPUT "Filename: "; filename$
                        OPEN filename$ FOR OUTPUT AS 1
                        FOR x = 1 TO TotalContracts
                                WRITE #1, Contract(x).Number, Contract(x).DateReceived.Day, Contract(x).DateReceived.Month, Contract(x).DateReceived.Year
                                WRITE #1, Contract(x).DatePayed.Day, Contract(x).DatePayed.Month, Contract(x).DatePayed.Year
                                WRITE #1, Contract(x).Amount
                        NEXT
                        GotIt = true
                CASE "d"  ' D for Delete data
                        VIEW PRINT 25 TO 25
                        FOR n = Current TO TotalContracts
                                Contract(n - 1) = Contract(n)
                        NEXT n
                        TotalContracts = TotalContracts - 1
                        GotIt = true
                CASE CHR$(0) + CHR$(81)  ' This one is Page Down
                        TopOfScreen = TopOfScreen + 15
                        IF TopOfScreen > TotalContracts THEN TopOfScreen = 1
                        GotIt = true
                CASE CHR$(0) + CHR$(73)  ' and page Up!
                        TopOfScreen = TopOfScreen - 15
                        IF TopOfScreen < 1 THEN TopOfScreen = 1
                        GotIt = true
                CASE CHR$(0) + CHR$(59) ' help bit
                        VIEW PRINT
                        CLS
                        OPEN "papers.hlp" FOR INPUT AS 1
                        DO UNTIL EOF(1)
                                LINE INPUT #1, a$
                                PRINT a$
                        LOOP
                        DO
                        LOOP UNTIL INKEY$ = CHR$(13)
                        CLOSE 1
                        GotIt = true
                CASE CHR$(0) + CHR$(72)  ' Up
                        LOCATE Current - TopOfScreen + 5, 1
                        COLOR 7
                        PRINT Contract(Current).Number; TAB(20);
                        PRINT USING "##/##/##"; Contract(Current).DateReceived.Day; Contract(Current).DateReceived.Month; Contract(Current).DateReceived.Year; TAB(32);
                        IF Contract(Current).DatePayed.Day <> 0 THEN PRINT USING "##/##/##"; Contract(Current).DatePayed.Day; Contract(Current).DatePayed.Month; Contract(Current).DatePayed.Year;
                        PRINT TAB(48);
                        PRINT USING "$$,####.##"; Contract(Current).Amount
                        Current = Current - 1
                        IF Current = 0 THEN Current = TotalContracts
                        GotIt = true
                        Redraw = false
                CASE CHR$(0) + CHR$(80)  ' Down
                        LOCATE Current - TopOfScreen + 5, 1
                        COLOR 7
                        PRINT Contract(Current).Number; TAB(20);
                        PRINT USING "##/##/##"; Contract(Current).DateReceived.Day; Contract(Current).DateReceived.Month; Contract(Current).DateReceived.Year; TAB(32);
                        IF Contract(Current).DatePayed.Day <> 0 THEN PRINT USING "##/##/##"; Contract(Current).DatePayed.Day; Contract(Current).DatePayed.Month; Contract(Current).DatePayed.Year;
                        PRINT TAB(48);
                        PRINT USING "$$,####.##"; Contract(Current).Amount
                        Current = Current + 1
                        IF Current > TotalContracts THEN Current = 1
                        GotIt = true
                        Redraw = false
                END SELECT
                IF Current < TopOfScreen THEN
                        TopOfScreen = Current - 15
                        IF TopOfScreen < 1 THEN TopOfScreen = 1
                        Redraw = true
                END IF
                IF Current > TopOfScreen + 17 THEN
                        TopOfScreen = TopOfScreen + 15
                        IF TopOfScreen > TotalContracts THEN TopOfScreen = TotalContracts
                        Redraw = true
                END IF
        LOOP UNTIL GotIt
        VIEW PRINT
LOOP UNTIL Done
SYSTEM

SUB DrawLine (row AS INTEGER)

' This sub draws a single line along the specified row

        LOCATE row, 1
        FOR i = 1 TO 80
                PRINT CHR$(196);
        NEXT
END SUB

SUB DrawScreen

' This sub draws the screen (not including the data) and also calculates
' a few things...

        VIEW PRINT
        TotalEarnt = 0
        TotalPayed = 0
        IF TotalContracts <> 0 THEN
                FOR i = 1 TO TotalContracts
                        TotalEarnt = TotalEarnt + Contract(i).Amount
                        IF Contract(i).DatePayed.Day <> 0 THEN TotalPayed = TotalPayed + Contract(i).Amount
                NEXT
        END IF
        CLS
        PRINT "Total Earnt:";
        PRINT USING "$$,########.##"; TotalEarnt;
        PRINT TAB(40); "Total Paid:";
        PRINT USING "$$,########.##"; TotalPayed
        DrawLine (2)
        PRINT "Contract:"; TAB(20); "Date:"; TAB(32); "Payed:"; TAB(48); "Amount:"
        DrawLine (4)
        DrawLine (24)
END SUB

SUB GetContract

' This sub gets contract details from the user

        VIEW PRINT 25 TO 25
        x = TotalContracts + 1
        INPUT "Number: "; Contract(x).Number
        INPUT "Date Received:  "; in$
        Contract(x).DateReceived.Year = VAL(RIGHT$(in$, 2))
        Contract(x).DateReceived.Month = VAL(MID$(in$, 4, 2))
        Contract(x).DateReceived.Day = VAL(LEFT$(in$, 2))
        INPUT "Date Payed: "; in$
        Contract(x).DatePayed.Year = VAL(RIGHT$(in$, 2))
        Contract(x).DatePayed.Month = VAL(MID$(in$, 4, 2))
        Contract(x).DatePayed.Day = VAL(LEFT$(in$, 2))
        INPUT "Amount: "; Contract(x).Amount
        TotalContracts = x
END SUB

SUB LoadData (filename AS STRING)

' This sub loads a datafile.  If DIR is given as the filename,
' then the directory is displayed, and the filename reprompted for

        ready = false
        IF filename$ = "dir" THEN
                FILES
                DO
                        PRINT
                        INPUT "Filename: "; filename$
                        IF filename$ = "dir" THEN FILES ELSE ready = true
                LOOP UNTIL ready
        END IF
        OPEN filename$ FOR INPUT AS 1
        x = 0
        DO UNTIL EOF(1)
                x = x + 1
                INPUT #1, Contract(x).Number, Contract(x).DateReceived.Day, Contract(x).DateReceived.Month, Contract(x).DateReceived.Year
                INPUT #1, Contract(x).DatePayed.Day, Contract(x).DatePayed.Month, Contract(x).DatePayed.Year
                INPUT #1, Contract(x).Amount
        LOOP
        CLOSE 1
        TotalContracts = x
END SUB

SUB PrintData

' This sub prints the data to the screen

        FOR i = TopOfScreen TO TopOfScreen + 17
                IF i > TotalContracts THEN
                        PRINT
                ELSE
                        IF i = Current THEN COLOR 15 ELSE COLOR 7
                        PRINT Contract(i).Number; TAB(20);
                        PRINT USING "##/##/##"; Contract(i).DateReceived.Day; Contract(i).DateReceived.Month; Contract(i).DateReceived.Year; TAB(32);
                        IF Contract(i).DatePayed.Day <> 0 THEN PRINT USING "##/##/##"; Contract(i).DatePayed.Day; Contract(i).DatePayed.Month; Contract(i).DatePayed.Year;
                        PRINT TAB(48);
                        PRINT USING "$$,####.##"; Contract(i).Amount
                        COLOR 7
                END IF
        NEXT
END SUB