home *** CD-ROM | disk | FTP | other *** search
- '*********************************************************************
- '* *
- '* PROGRAMNAME : TABLDEMO.BAS *
- '* *
- '* DESCRIPTION : this program shows you how to declare a *
- '* table, how to write it onto the screen, *
- '* how to select an item and how to reenter *
- '* the table. *
- '* *
- '* REMARKS : names of constants in include modules are *
- '* in dutch language foreign users may alter *
- '* names as desired *
- '* *
- '* REV DATE HISTORY *
- '* 0.0 18JAN92 Bernard Veerman - version for QB-NEWS *
- '* *
- '*********************************************************************
-
- DEFINT A-Z
-
- COMMON SHARED TablDefs()
- COMMON SHARED TOP, ROW, COL, HGT, WID, SF, SB, BF, BB, PTR, CUR, BTP
- '
- ' subprograms to be called by user
- '
- DECLARE SUB TABLOPEN (TNR, TOP, ROW, COL, HGT, WID, SF, SB, BF, BB, TY$)
- DECLARE SUB TABLSLCT (TNR, Table$(), Entry$)
- '
- ' subprogram to be called by subprogram TABLSLCT
- '
- DECLARE SUB DRAWBOX (ROW, COL, VRT, HOR, TY$)
- DECLARE SUB TABLDISP (TNR, PTR, Table$())
- DECLARE SUB TABLLINE (TNR, CUR, Video$)
- DECLARE SUB TABLLOAD (TNR)
- '
- ' include modules for keyboard and colors
- '
- ' $INCLUDE: 'VZKEYBRD.BAS'
- ' $INCLUDE: 'VZCOLORS.BAS'
-
- DIM TablDefs(6, 12)
-
- '---------------------------------------------------------------------
- '------- now forget all previous work and look at this coding --------
- '------------- first, declare any matrix and fill it up --------------
- '------- with anything you want (file, table, directory etc.) --------
- '--------------- than just move thru the table and pick --------------
- '---------------------------------------------------------------------
-
- CLS
- DATA Ford,Chevrolet,Oldsmobile,Cadillac,Chrysler,Pontiac,Edsel
- DATA Studebaker,Skoda,Honda,Mazda,Volvo,Volkswagen,Toyota,Peugeot
-
- DATA Washington,Oregon,Idaho,Montana,Wyoming,North Dakota,South Dakota
- DATA Nebraska,Minnesota,Wisconsin,Iowa,Illinois,Indiana,Mitchigan,Ohio
- DATA Pennsylvania,New York,Maine,California,Nevada,Utah,Colorado
- DATA Arizona,New Mexico,Kansas,Missouri,Kentucky,West Virginia
- DATA Virginia,Texas,Oklahoma,Arkansas,Louisiana,Tennessee
- DATA North Carolina,South Carolina,Mississippi,Alabama,Georgia,Florida
- DATA Hawai,Alaska,Vermont,New Hampshire,Massachusetts,Connecticut
- DATA Jersey,Maryland,Rhode Island,Delaware
-
- DIM Cars$(15) 'just some cars
- FOR X = 1 TO 15 'get their names
- READ Cars$(X) 'fill table
- NEXT 'done ?
-
- DIM States$(50) 'I did my best to get all of
- FOR X = 1 TO 50 'them 51 states, but... oops
- READ States$(X) 'I can't figure out which one
- NEXT 'is missing. Sorry for that!
-
- DIM YN$(2) 'just another example
- YN$(1) = " Yes "
- YN$(2) = " No "
-
- TABLOPEN 1, 15, 8, 30, 10, 30, WT, ZW, ZW, WT, "d"
- TABLOPEN 2, 50, 4, 10, 16, 25, ZW, WT, WT + HLDR, ZW, "s"
- TABLOPEN 3, 2, 19, 70, 4, 9, WT, ZW, ZW + BLNK, WT, "s"
-
- TABLSLCT 1, Cars$(), YourPick$ 'table = CARS ----->>>----+
- TABLSLCT 2, States$(), Bingo$ 'table = STATES --->>>--+ |
- TABLSLCT 3, YN$(), NowWhat$ 'table = YN ------->>>--|-|-+
- ' | | |
- CLS 'clear screen | | |
- FOR X = 1 TO 24 'paint background | | |
- PRINT STRING$(80, CHR$(176)); ' | | |
- NEXT ' | | |
- Text$ = " any key to re-enter table " ' | | |
- LOCATE 12, (80 - LEN(Text$)) \ 2, 0 ' | | |
- PRINT Text$; ' | | |
- X$ = INPUT$(1) 'wait for keyboard | | |
- ' | | |
- TABLSLCT 2, States$(), Bingo$ 'RE-ENTER TABLE ---<<<--+ | |
- TABLSLCT 1, Cars$(), YourPick$ 'RE-ENTER TABLE ---<<<----+ |
- ' |
- LOCATE 24, 1 ' |
- PRINT SPACE$(80); ; ' |
- LOCATE 24, 1 ' |
- PRINT " your pick : "; YourPick$; ' |
- ' |
- TABLSLCT 3, YN$(), OK$ 'done, yes anyway -<<<------+
- COLOR WT, ZW 'reset white on black
- CLS
-
- 'page
- '
- SUB DRAWBOX (ROW, COL, VRT, HOR, TY$)
-
- '*********************************************************************
- '* *
- '* PROGRAMNAME : DRAWBOX, draws a box on the screen. The *
- '* contents of the box will not be destroyed. *
- '* *
- '* PARAMETERS : ROW = valid row from 1 thr 25 *
- '* COL = valid column from 1 thru 80 *
- '* VRT = heigth of box (vertical) *
- '* HOR = length of box (horizontal) *
- '* TY$ = line type, d= double, s = single *
- '* where single is the default value *
- '* *
- '* REMARKS : validation of line/columns/heigth/width *
- '* is supposed to be done by the programmer *
- '* *
- '* VER DATE HISTORY *
- '* 0.0 18JAN92 Bernard Veerman - version for QB NEWS *
- '* *
- '*********************************************************************
-
- IF UCASE$(TY$) = "D" THEN 'double lines ?
- LTOP$ = CHR$(DCTL): RTOP$ = CHR$(DCTR) 'top left/right
- LBOT$ = CHR$(DCBL): RBOT$ = CHR$(DCBR) 'bottom left/right
- HLIN$ = CHR$(DLHO): VLIN$ = CHR$(DLVE) 'line hor/vert
- ELSE 'single line (default)
- LTOP$ = CHR$(SCTL): RTOP$ = CHR$(SCTR) 'top left/right
- LBOT$ = CHR$(SCBL): RBOT$ = CHR$(SCBR) 'bottom left/right
- HLIN$ = CHR$(SLHO): VLIN$ = CHR$(SLVE) 'line hor/vertical
- END IF
-
- HORL$ = STRING$(HOR - 2, HLIN$) 'make horizontal line
- COLRT = COL + HOR - 1 'calc right column
-
- LOCATE ROW, COL 'top left location
- PRINT LTOP$; HORL$; RTOP$; 'diplay top line
- LOCATE ROW + VRT - 1, COL 'bottom left location
- PRINT LBOT$; HORL$; RBOT$; 'display bottom line
-
- FOR X = ROW + 1 TO ROW + VRT - 2 'fill in the sides
- LOCATE X, COL: PRINT VLIN$; 'left side
- LOCATE X, COLRT: PRINT VLIN$; 'right side
- NEXT 'done ?
-
- END SUB
-
- 'page
- '
- SUB TABLDISP (TNR, PTR, Table$())
-
- '*********************************************************************
- '* *
- '* PROGRAMNAME : TABLDISP, displays a table *
- '* *
- '* PARAMETERS : TNR = table number *
- '* PTR = record pointer *
- '* Table$() = table name *
- '* *
- '* VER DATE HISTORY *
- '* 0.0 18JAN92 Bernard Veerman - version for QB NEWS *
- '* *
- '*********************************************************************
-
- TABLLOAD TNR 'get parms
-
- XPTR = PTR 'temp rec pointer
- XROW = ROW 'temp line pointer
-
- DO 'display table
- LOCATE XROW, COL 'position cursor
- PRINT LEFT$(Table$(XPTR), WID); 'display entry
- IF LEN(Table$(XPTR)) < WID THEN 'trailing blanks
- PRINT SPACE$(WID - LEN(Table$(XPTR)));
- END IF
-
- XROW = XROW + 1 'incr display row
- XPTR = XPTR + 1 'incr record pointer
-
- LOOP UNTIL XROW - ROW = HGT 'all lines displayed ?
-
- END SUB
-
- 'page
- '
- SUB TABLLINE (TNR, CUR, Video$)
-
- '*********************************************************************
- '* *
- '* PROGRAMNAME : TABLLINE, displays a line in the table *
- '* *
- '* PARAMETERS : TNR = table number *
- '* CUR = current line in table *
- '* Video$ = normal or reversed video *
- '* *
- '* REMARKS : fore- and background colors from TablDefs *
- '* *
- '* VER DATE HISTORY *
- '* 0.0 18JAN92 Bernard Veerman - version for QB NEWS *
- '* *
- '*********************************************************************
-
- TABLLOAD TNR 'get parms
-
- ABSROW = ROW + CUR - 1 'calc absolute display line
- LOCATE ABSROW, COL 'position cursor
-
- ThisLine$ = SPACE$(WID) 'init string
- FOR ThisChar = 1 TO WID 'read screen
- MID$(ThisLine$, ThisChar) = CHR$(SCREEN(ABSROW, COL + ThisChar - 1))
- NEXT
-
- IF UCASE$(Video$) = "N" THEN 'normal video ?
- COLOR SF, SB 'set screen colors
- PRINT ThisLine$; 'display line at ABSROW, COL
- ELSE 'reversed video
- COLOR BF, BB 'set bar colors
- PRINT ThisLine$; 'display line at ABSROW, COL
- COLOR SF, SB 'set screen colors
- END IF 'done
-
- END SUB
-
- 'page
- '
- SUB TABLLOAD (TNR)
-
- '*********************************************************************
- '* *
- '* PROGRAMNAME : TABLLOAD, loads parms for a table *
- '* CUR + PTR are variables and are passed *
- '* as parameters when called *
- '* *
- '* PARAMETERS : TNR = table number *
- '* *
- '* VER DATE HISTORY *
- '* 0.0 18JAN92 Bernard Veerman - version for QB NEWS *
- '* *
- '*********************************************************************
-
- TOP = TablDefs(TNR, 1) 'table top
- ROW = TablDefs(TNR, 2) 'display row
- COL = TablDefs(TNR, 3) 'display column
- HGT = TablDefs(TNR, 4) 'height
- WID = TablDefs(TNR, 5) 'width
- BTP = TablDefs(TNR, 12) 'box type
-
- SF = TablDefs(TNR, 6) 'screen foreground
- SB = TablDefs(TNR, 7) 'screen background
- BF = TablDefs(TNR, 8) 'bar foreground
- BB = TablDefs(TNR, 9) 'bar background
-
- END SUB
-
- 'page
- '
- SUB TABLOPEN (TNR, TOP, ROW, COL, HGT, WID, SF, SB, BF, BB, TY$)
-
- '*********************************************************************
- '* *
- '* PROGRAMNAME : TABLOPEN, saves the parameters of a table *
- '* for further use. Re-entry is made possible *
- '* *
- '* PARAMETERS : TNR = tablenumber 1 thru 6 (see TABLDEFS) *
- '* TOP = table size *
- '* ROW = display row *
- '* COL = display column *
- '* HGT = table heigth (lines 1-25) *
- '* WID = table width (columns 1-80) *
- '* SF = screen color foreground *
- '* SB = screen color background *
- '* BF = bar color foreground *
- '* BB = bar color background *
- '* TY$ = line type for drawbox *
- '* "" = no box, s = single, d = double *
- '* *
- '* REMARKS : validation of line/columns/heigth/width *
- '* is supposed to be done by the programmer *
- '* *
- '* VER DATE HISTORY *
- '* 0.0 18JAN92 Bernard Veerman - version for QB NEWS *
- '* *
- '*********************************************************************
-
- IF LEN(TY$) = 0 THEN 'no box wanted
- TablDefs(TNR, 12) = 0 'make boxtype 0
- ELSE 'box wanted
- TablDefs(TNR, 12) = INSTR("SD", UCASE$(TY$)) 'make boxtype 1 or 2
- ROW = ROW + 1: COL = COL + 1 'adjust row & column
- HGT = HGT - 2: WID = WID - 2 'adjust heigth & width
- END IF
-
- TablDefs(TNR, 1) = TOP 'table size
- TablDefs(TNR, 2) = ROW 'display row
- TablDefs(TNR, 3) = COL 'display column
- TablDefs(TNR, 4) = HGT 'table height
- TablDefs(TNR, 5) = WID 'table width
- TablDefs(TNR, 6) = SF 'screen foreground
- TablDefs(TNR, 7) = SB 'screen background
- TablDefs(TNR, 8) = BF 'bar foreground
- TablDefs(TNR, 9) = BB 'bar background
- TablDefs(TNR, 10) = 1 'init record pointer
- TablDefs(TNR, 11) = 1 'init current line
-
- END SUB
-
- 'page
- '
- SUB TABLSLCT (TNR, Table$(), Entry$)
-
- '*********************************************************************
- '* *
- '* PROGRAMNAME : TABLSLCT, select entry from table *
- '* *
- '* PARAMETERS : TNR = table number *
- '* Table$() = table name *
- '* Entry$ = selected entry or <ESCAPE> *
- '* *
- '* REMARKS : validation of line/columns/heigth/width *
- '* is supposed to be done by the programmer *
- '* *
- '* VER DATE HISTORY *
- '* 0.0 18JAN92 Bernard Veerman - version for QB NEWS *
- '* *
- '*********************************************************************
-
- TABLLOAD TNR 'get parms
- PTR = TablDefs(TNR, 10) 'copy record pointer
- CUR = TablDefs(TNR, 11) 'copy line pointer
-
- COLOR SF, SB 'set colors (for DRAWBOX)
- LOCATE , , 0 'hide cursor
-
- IF TOP < HGT THEN HGT = TOP 'safety first
- IF BTP > 0 THEN 'box wanted ?
- TY$ = MID$("SD", BTP, 1) 'get box type
- DRAWBOX ROW - 1, COL - 1, HGT + 2, WID + 2, TY$
- END IF
-
- TABLDISP TNR, PTR, Table$() 'display the table
- TABLLINE TNR, CUR, "R" 'first display line
-
- DO 'this is the main loop
- DO 'wait for a character
- C$ = INKEY$ 'read keyboard
- LOOP UNTIL C$ <> "" 'anything yet ?
-
- TABLLINE TNR, CUR, "N" 'normal video
-
- SELECT CASE C$ 'what have we got ?
-
- CASE CHR$(Entr) 'enter
- Entry$ = Table$(PTR + CUR - 1) 'copy entry from table
-
- CASE CHR$(Escp) 'escape
- Entry$ = "<ESCAPE>" 'easy if you're interested
-
- CASE CHR$(Null) + CHR$(CurH) 'cursor home current page
- CUR = 1 'goto first line in page
-
- CASE CHR$(Null) + CHR$(CurE) 'cursor end current page
- CUR = HGT 'goto last line in page
-
- CASE CHR$(Null) + CHR$(CtlH) 'cursor home first page
- CUR = 1 'reset line pointer
- PTR = 1 'reset record pointer
- TABLDISP TNR, PTR, Table$() 'display first page
-
- CASE CHR$(Null) + CHR$(CtlE) 'cursor end last page
- CUR = HGT 'set line pointer
- PTR = TOP - HGT + 1 'set record pointer
- TABLDISP TNR, PTR, Table$() 'display last page
-
- CASE CHR$(Null) + CHR$(PgUp) 'page up
- PTR = PTR - HGT 'decr pagesize
- IF PTR < 1 THEN 'past begin of file ?
- CUR = 1 'reset line pointer
- PTR = 1 'reset record pointer
- END IF '
- TABLDISP TNR, PTR, Table$() 'display previous page
-
- CASE CHR$(Null) + CHR$(PgDn) 'page down
- PTR = PTR + HGT 'incr pagesize
- IF PTR > TOP - HGT + 1 THEN 'past end of file ?
- CUR = HGT 'set line pointer
- PTR = TOP - HGT + 1 'set record pointer
- END IF '
- TABLDISP TNR, PTR, Table$() 'display next page
-
- CASE CHR$(Null) + CHR$(ArrU) 'arrow up + scroll
- CUR = CUR - 1 'decr line pointer
- IF CUR < 1 THEN 'out of page bound ?
- CUR = 1 'reset line pointer
- IF PTR > 1 THEN 'valid record pointer ?
- PTR = PTR - 1 'decr record pointer
- TABLDISP TNR, PTR, Table$()
- END IF
- END IF
-
- CASE CHR$(Null) + CHR$(ArrD) 'arrow down + scroll
- CUR = CUR + 1 'incr line pointer
- IF CUR > HGT THEN 'out of page bound ?
- CUR = HGT 'set line pointer
- IF TOP - PTR >= HGT THEN 'valid record pointer ?
- PTR = PTR + 1 'incr record pointer
- TABLDISP TNR, PTR, Table$()
- END IF
- END IF
-
- END SELECT
-
- TABLLINE TNR, CUR, "R"
-
- LOOP UNTIL C$ = CHR$(Entr) OR C$ = CHR$(Escp)
-
- LOCATE , , 1 'unhide cursor
- TablDefs(TNR, 10) = PTR 'save record pointer
- TablDefs(TNR, 11) = CUR 'save current line
-
- END SUB
-
-
