'********************************************************************* '* * '* 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 * '* * '* 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$ = "" '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