$CPU 8086 'make compatible with XT systems $LIB ALL OFF 'turn off all PowerBASIC libraries $ERROR ALL OFF 'turn off all PowerBASIC error checking $OPTIMIZE SIZE 'optimize for smaller code $COMPILE UNIT 'compile to a UNIT (.PBU) '$COMPILE EXE 'compile to a UNIT (.PBU) DEFINT A-Z 'Required for all numeric functions, forces PB to not 'include floating point in UNIT (makes it smaller) '/*------------------------------------------------------------------*/ $CODE SEG "MLIB11" '/*------------------------------------------------------------------- DECLARE SUB BWINDOW(Title$,Toprow%,Leftcolumn%,Bottomrow%,Rightcolumn%,Attr%,Shadow%,Border%) DECLARE FUNCTION TRIML(Strng$,Amount%) AS STRING DECLARE SUB SAY(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Text AS STRING, BYVAL Attr AS INTEGER) DECLARE SUB SATTR(BYVAL XN AS INTEGER) DECLARE SUB MCLICKED(Rgt%,Lft%,Row%,Col%) DECLARE SUB MOUSEOFF() DECLARE SUB MOUSEON() DECLARE SUB MLOCATE(BYVAL ROW,BYVAL COL) DECLARE FUNCTION ISMOUSELBR() DECLARE FUNCTION ISMOUSERBR() DECLARE FUNCTION GETSCREEN() AS STRING DECLARE SUB PUTSCREEN(BYVAL X AS STRING) '/*------------------------------------------------------------------- SUB SBOX(TOPROW%,LEFTCOLUMN%,Title$,CHOICES$(),ROPT%,RKEY$,Rtrn$,WINSIZE%,DMOUSE%,TAG%,DefaultPointer%,HIATTR%,ATTR%,BATTR%,OPT%) PUBLIC SCREEN1$ = GETSCREEN RKEYS$ = RKEY$ IF TOPROW% = 0 AND LEFTCOLUMN% = 0 THEN CENTRE% = 1 ELSE CENTRE% = 0 IF TOPROW% = 0 AND LEFTCOLUMN% <> 0 THEN TOPROW% = 12 - WINSIZE / 2 END IF IF RKEY$ = "EXIT" THEN HIATTR% = ATTR% i% = 0 :'/*loop counter j% = 0 :'/*loop compare Maxlength% = LEN(Title$)+4 :'/*string length counter IF DMOUSE% THEN MOUSEOFF DO INCR i% INCR j% :'/*first find out how many :'/*strings there are and the length of the longest one IF LEN (Choices$(i%)) = 0 THEN DECR i% ELSE IF LEN (Choices$(i%)) > Maxlength% THEN Maxlength% = LEN (Choices$(i%)) END IF LOOP WHILE i% = j% Count% = i% Rtrn$ = "" INCR Maxlength% :'/*add a space '/*--- Determine Left Column if 0 ---/* IF LEFTCOLUMN% = 0 AND TOPROW% <> 0 THEN LEFTCOLUMN% = 40 - ((Maxlength+2)/2) IF LEFTCOLUMN% < 1 THEN LEFTCOLUMN% = 1 END IF LessThanWinsize% = 0 :'/*initialize to zero IF DefaultPointer% = 0 THEN DefaultPointer% = 1 '/*--- Add Leading Space for Marker Incase Needed ---*/ FOR i% = 1 TO Count% IF LEFT$(Choices$(i%),1) <> " " THEN Choices$(i%) = " " + Choices$(i%) NEXT i% '/*--- Is Number of Items < Window Size? ---*/ IF Count% <= Winsize% - 1 THEN LessThanWinsize% = 1 END IF '/*--- Set Finish Var ---*/ IF LessThanWinsize% THEN Finish% = Count% ScrollTBAR% = 0 ELSE '/*--- Fixed Size Scrolling Box ---*/ Finish% = Winsize% ScrollTBAR% = Count% \ (Winsize% - 2) END IF IF Finish% > Count% THEN Finish% = Count IF Start% < 1 THEN Start% = 1 '/*--- Center Box? ---*/ IF Centre% THEN 'do they want it centred LeftColumn% = 40 - ((Maxlength% + 2) \ 2) RightColumn% = LeftColumn% + (Maxlength%) + 2 TopRow% = (25 - Finish% ) \ 2 BottomRow% = TopRow% + (Finish% + 1) ELSE ' RightColumn% = LeftColumn% + (Maxlength% + 2) RightColumn% = LeftColumn% + (Maxlength%) + 2 BottomRow% = TopRow% + (Finish% + 1) END IF '/*--- Draw Box ---*/ '/*BBOX TopRow%, LeftColumn%, BottomRow%, RightColumn%, BATTR%, OPT% 'SAY 25,1,STR$(TopRow%)+STR$(LeftColumn%)+STR$(BottomRow%)+STR$(RightColumn%),31 'Y$ = GETKEY BWINDOW Title$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,BATTR%,0,OPT% '/*--- Mouse? ---*/ 'IF DMOUSE% THEN ' Test% = LEN(Title$) ' IF Test% THEN ' IF Test% + 12 <= RightColumn% - LeftColumn% THEN '/* COLOR FGround%,BGround% '/* LOCATE TopRow%,LeftColumn% + 1,0 '/* PRINT CHR$(91,254,93); ' SAY TopRow%,LeftColumn%+2,CHR$(254),BATTR% ' ELSE '/* COLOR FGround%,BGround% '/* LOCATE BottomRow%,LeftColumn% + 1,0 '/* PRINT CHR$(91,254,93); ' SAY TopRow%,LeftColumn%+2,CHR$(254),BATTR% ' END IF ' ELSE '/* COLOR FGround%,BGround% '/* LOCATE TopRow%,LeftColumn% + 1,0 '/* PRINT CHR$(91,254,93); ' SAY TopRow%,LeftColumn%+2,CHR$(254),BATTR% ' END IF 'END IF '/*--- Preposition Selection Bar? ---*/ IF DefaultPointer% > 0 THEN Pointer% = DefaultPointer% '/*--- Normal Position? ---*/ IF Pointer% > Winsize% THEN Start% = Pointer% Finish% = Start% + Winsize% - 1 END IF '/*--- On Last Page? ---*/ IF DefaultPointer% => (Count% - Winsize)+1 THEN Start% = (Count% - Winsize%) + 1 Finish% = Count% END IF '/*--- Last ITEM? ---*/ IF DefaultPointer% = Count% THEN Start% = (Count% - Winsize%) + 1 Finish% = Count% END IF '/*--- 1st Page? ---*/ IF DefaultPointer% <= Winsize% THEN Start% = 1 Finish% = Winsize% END IF '/*--- Ensure Min/Max Values ---*/ IF Start% < 1 THEN Start% = 1 IF Finish% > Count% THEN Finish% = Count% END IF '/*--- Init Selection Made Var ---*/ SelectionMade% = 0 '/*--- Display Choices ---*/ DO PrintRoutine: IF DMOUSE% THEN MOUSEOFF TBAR% = 0 Row% = TopRow% + 1 Col% = LeftColumn% + 1 FOR a% = Start% TO Finish% IF a% = Pointer% THEN '/* SATTR HIATTR% '/* LOCATE Row%,Col%,0 '/* PRINT Choices$(a%) + SPACE$(Maxlength% - LEN(Choices$(a%)) + 1) SAY Row%,Col%,Choices$(a%)+SPACE$(Maxlength%-LEN(Choices$(a%))+1),HIATTR% ELSE '/* SATTR ATTR% '/* LOCATE Row%,Col%,0 SAY Row%,Col%,Choices$(a%)+SPACE$(Maxlength%-LEN(Choices$(a%))+1),ATTR% END IF '/* --- Update Scroll Bar Status ---*/ IF ScrollTBAR% THEN '/* SATTR BATTR% '/* LOCATE Row%,RightColumn%,0 IF a% = Start% THEN '/* PRINT CHR$(24); '/* SAY Row%,RightColumn%,CHR$(24),BATTR% ELSEIF a% = Finish% THEN '/* PRINT CHR$(25); '/* SAY Row%,RightColumn%,CHR$(25),BATTR% ELSE IF TBAR% = 0 THEN c% = Pointer% FOR i% = 1 TO ScrollTBAR% b% = c% \ ScrollTBAR% IF a% = b% + Start% THEN TBAR% = 1 EXIT FOR ELSE INCR c% END IF NEXT i% IF TBAR% THEN '/* PRINT CHR$(254); '/* SAY Row%,RightColumn%+2,CHR$(254),BATTR% SAY Row%,RightColumn%,CHR$(254),BATTR% ELSE IF TBAR% = 0 AND a% = Finish% - 1 THEN '/* PRINT CHR$(254); '/* SAY Row%,RightColumn%+2,CHR$(254),BATTR% SAY Row%,RightColumn%,CHR$(254),BATTR% ELSE '/* PRINT CHR$(176); '/* SAY Row%,RightColumn%+2,CHR$(176),BATTR% SAY Row%,RightColumn%,CHR$(176),BATTR% END IF END IF ELSE '/* PRINT CHR$(176); '/* SAY Row%,RightColumn%+2,CHR$(176),BATTR% SAY Row%,RightColumn%,CHR$(176),BATTR% END IF END IF END IF INCR Row% NEXT a% '/*-- Display Choices then Exit? ---*/ IF RKEY$ = "EXIT" THEN Rtrn$ = "" EXIT LOOP END IF WHILE NOT INSTAT IF DMOUSE% THEN IF SaveMouse% THEN MLOCATE MouseRow%,MCol% Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0:SaveMouse% = 0 MOUSEON MCLICKED Rgt%,Lft%,MRow%,MCol% IF MRow% >= TopRow% AND MRow% =< BottomRow% AND MCol% >= LeftColumn% AND MCol% =< RightColumn% THEN IF MRow% > TopRow% AND MRow% < BottomRow% AND MCol% > LeftColumn% AND MCol% < RightColumn% THEN MOUSEOFF IF ISMOUSERBR THEN IF Tag% THEN Chose% = 32: GOTO KeyBoardRoutine END IF ELSEIF ISMOUSELBR THEN RKEY$ = CHR$(13) Chose% = 13: GOTO KeyBoardRoutine END IF IF LessThanWinsize% THEN Pointer% = MRow% - TopRow% GOTO PrintRoutine ELSE Offset% = MRow% - (TopRow% + 1) Pointer% = Start% + Offset% GOTO PrintRoutine END IF ELSE SELECT CASE MRow% CASE TopRow% IF MCol% = LeftColumn% THEN IF ISMOUSELBR THEN 'Cancel Box bottom RKEY$ = CHR$(27) Chose% = 27: GOTO KeyBoardRoutine END IF END IF '/* CASE TopRow% + 1 '/* IF MCol% = RightColumn% THEN '/* IF Lft% THEN Chose% = -72: GOTO KeyBoardRoutine IF Lft% THEN Chose% = -72 DELAY .05 GOTO KeyBoardRoutine END IF '/* IF LeftButton% THEN '/* Chose% = -73: GOTO KeyBoardRoutine '/* END IF '/* END IF '/* CASE BottomRow% - 1 CASE BottomRow% '/* IF MCol% = RightColumn% THEN '/* IF Lft% THEN Chose% = -80: GOTO KeyBoardRoutine IF Lft% THEN Chose% = -80 DELAY .05 GOTO KeyBoardRoutine END IF '/* IF ISMOUSELBR% THEN '/* Chose% = -81: GOTO KeyBoardRoutine '/* END IF '/* END IF '/* CASE BottomRow% '/* SELECT CASE MCol% '/* CASE LeftColumn% + 2 '/* IF ISMOUSELBR% THEN 'Cancel Box bottom '/* Chose% = 27: GOTO KeyBoardRoutine '/* END IF '/* END SELECT END SELECT END IF ELSE IF ISMOUSELBR AND MCol% = LeftColumn% THEN Chose% = 27: GOTO KeyBoardRoutine END IF END IF END IF WEND '/* --- Get Keystroke ---*/ KeyBoardRoutine1: Ky$ = INKEY$ IF INSTR(1,RKEYS$,Ky$) > 0 THEN RKEY$ = Ky$ GOTO SBOXEEXIT END IF RKEY$ = Ky$ IF LEN(Ky$) = 1 THEN Chose% = ASC(Ky$) END IF IF LEN(Ky$) > 1 THEN Chose% = ASC(RIGHT$(Ky$,1)) Chose% = Chose% * -1 END IF KeyBoardRoutine: IF DMOUSE% THEN IF MRow% > TopRow% AND MRow% < BottomRow% AND _ MCol% > LeftColumn% AND MCol% < RightColumn% THEN SaveMouse% = 1 MLOCATE 1,1 END IF END IF SELECT CASE Chose% CASE 13 'enter key, exit and pass the SelectionMade% = 1 'selection to Rtrn$ IF Tag% > 0 THEN IF LEN(Rtrn$) THEN Rtrn$ = Rtrn$ ELSE Rtrn$ = "" END IF ELSE IF ROPT% = 0 THEN Rtrn$ = LTRIM$(Choices$(Pointer%)) ELSE Rtrn$ = STR$(Pointer%) END IF END IF CASE 27 'Esc key, just exit routine SelectionMade% = 1 Rtrn$ = "" CASE 32 IF Tag% THEN IF INSTR(Choices$(Pointer%),CHR$(Tag%)) THEN IF ROPT% = 0 THEN Rtrn$ = REMOVE$(Rtrn$,Choices$(Pointer%)) ELSE Rtrn$ = REMOVE$(Rtrn$,STR$(Pointer%)) END IF Choices$(Pointer%) = " " + LTRIM$(Choices$(Pointer%),CHR$(Tag%)) ELSE Choices$(Pointer%) = CHR$(Tag%) + TRIML(Choices$(Pointer%),1) IF ROPT% = 0 THEN Rtrn$ = Rtrn$ + Choices$(Pointer%) ELSE Rtrn$ = Rtrn$ + STR$(Pointer%) END IF END IF IF LessThanWinsize% THEN 'it's not a scrolling box IF Pointer% < Finish% THEN INCR Pointer% ELSE Pointer% = Start% END IF ELSE 'it's a scrolling box IF Pointer% < Finish% THEN INCR Pointer% ELSEIF Finish% < Count% THEN 'check to see if we have INCR Pointer% 'any more choices waiting INCR Start% INCR Finish% END IF END IF END IF CASE 65 TO 90,97 TO 122 Found% = 0: Marker% = Pointer% IF Pointer% + 1 <= Count% THEN 'search forward from pointer FOR i% = Pointer% + 1 TO Count% Temp$ = LEFT$(Choices$(i%),2) 'get two characters TestKey$ = UCASE$(RIGHT$(Temp$,1)) 'char after the space or tag IF TestKey$ = UCASE$(CHR$(Chose%)) THEN 'compare first char to key Found% = 1 Pointer% = i% IF LessThanWinsize% = 0 THEN IF Pointer% + Winsize% <= Count% THEN Finish% = Pointer% + (Winsize% - 1) Start% = Finish% - (Winsize% - 1) ELSE Finish% = Count% Start% = Finish% - (Winsize% - 1) END IF END IF EXIT FOR END IF NEXT i% END IF IF Found% = 0 THEN FOR j% = 1 TO Pointer% Temp$ = LEFT$(Choices$(j%),2) TestKey$ = UCASE$(RIGHT$(Temp$,1)) IF TestKey$ = UCASE$(CHR$(Chose%)) THEN Found% = 1: Pointer% = j% IF Pointer% = Marker% THEN BEEP: EXIT FOR ELSE IF LessThanWinsize% = 0 THEN IF Pointer% + Winsize% <= Count% THEN Finish% = Pointer% + (Winsize% - 1) Start% = Finish% - (Winsize% - 1) ELSE Finish% = Count% Start% = Finish% - (Winsize% - 1) END IF END IF END IF EXIT FOR END IF NEXT j% END IF IF Found% = 0 THEN BEEP END IF CASE -71 'home key Pointer% = Start% CASE -72 'up arrow IF LessThanWinsize% THEN 'it's not a scrolling box IF Pointer% > Start% THEN DECR Pointer% ELSE Pointer% = Finish% END IF ELSE 'it's a scrolling box IF Pointer% > Start% THEN DECR Pointer% ELSEIF Start% > 1 THEN DECR Pointer% DECR Start% DECR Finish% END IF END IF CASE -73 'page up IF Start% - (Winsize% - 1) >= 1 THEN 'this block handles the DECR Start%,(Winsize% - 1) 'pageing DECR Pointer%,(Winsize% - 1) DECR Finish%,(Winsize% - 1) ELSE Pointer% = 1: Start% = 1 IF LessThanWinsize% THEN 'if we jump back to Start% make Finish% = Count% 'sure we check to see what kind ELSE 'of scroll box and set Finish% Finish% = Winsize% 'accordingly END IF END IF CASE -79 'end key Pointer% = Finish% CASE -80 'down arrow IF LessThanWinsize% THEN 'it's not a scrolling box IF Pointer% < Finish% THEN INCR Pointer% ELSE Pointer% = Start% END IF ELSE 'it's a scrolling box IF Pointer% < Finish% THEN INCR Pointer% ELSEIF Finish% < Count% THEN 'check to see if we have INCR Pointer% 'any more choices waiting INCR Start% INCR Finish% END IF END IF CASE -81 'page down IF Finish% + (Winsize% - 1) <= Count% THEN 'this block handles INCR Start%,(Winsize% - 1) 'the pageing INCR Finish%,(Winsize% - 1) INCR Pointer%,(Winsize% - 1) ELSE Pointer% = Count%: Finish% = Count% IF LessThanWinsize% THEN 'if we jump to Finish% make Start% = 1 'sure we check to see what ELSE 'kind of scroll box and set Start% = Count% - (Winsize% - 1) 'Start% accordingly END IF END IF END SELECT LOOP UNTIL SelectionMade% '/*--- Remove Marker Byte ---*/ FOR i% = 1 TO Count% IF INSTR(Choices$(i%),CHR$(Tag%)) THEN Choices$(i%) = LTRIM$(Choices$(i%),CHR$(Tag%)) 'remove tag char ELSE Choices$(i%) = LTRIM$(Choices$(i%)) 'remove the space END IF NEXT i% '/*--- Reset Mouse/Cursor Vars/Positions ---*/ IF DMOUSE% THEN IF MRow% > TopRow% AND MRow% < BottomRow% AND _ MCol% > LeftColumn% AND MCol% < RightColumn% THEN SaveMouse% = 1 MLOCATE 1,1 END IF END IF '/*--- Restore Screen ---*/ SBOXEEXIT: IF RKEY$ <> "EXIT" THEN PUTSCREEN SCREEN1$ END SUB '/*------------------------------------------------------------------- ' $INCLUDE "E:\CODE\MLIB\MLIB.INC" ' CLS ' DIM CHOICES$(5000) ' OPEN"I",1,"C:\UTIL\MHELP\PB.BDX" ' CNT = 0 ' DO ' CNT = CNT + 1 ' LINE INPUT#1,CHOICES$(CNT) ' CHOICES$(CNT) = LEFT$(CHOICES$(CNT),53) ' LOOP UNTIL EOF(1) ' CLOSE#1 ' FOR CNT = 1 TO 11 ' GETFILES "E:\UTIL\MHELP\*.HLP",CHOICES$() ' RTRN$ = "" ' RKEY$ = "" ' SBOX 2,3,"The Title",CHOICES$(),1,RKEY$,RTRN$,10,1,0,0,31,48,12,1 ' LOCATE 24,1,,0 ' PRINT RTRN$ ' PRINT RKEY$ ' Y$ = GETKEY ' NEXT CNT '/*-------------------------------------------------------------------