'===========================================================================
' Subject: OPEN UP TO 16 POPUP BOXES          Date: 06-24-96 (00:00)       
'  Author: Charles Godard                     Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: MENU.ABC
'===========================================================================
'NewPopu1.bas by Charles Godard, 06/24/96
'Popup boxes over boxes; 16 open at one time!
'<<<<<<<<<This Version is made for Qbasic>>>>>>>>>
'Many thanks to Gary Godard for the suggestion to use the ScreenPram
'and for a good explanation of how to use multiple dimension arrays

'No Border = 0, single = 1, double = 2
'shutUP by itself closes the last box opened

'The number of Boxes% open at once, depends on Dgroup Memory available.
'I have tested it up to 15 boxes open at one time in this program.
'Each box requires 4000 bytes. That's 2000 for the character and
'2000 for the attribute times the number of screens open at once.
'You cannot exceed 64k at one time with all routines including
'whatever else your program is using.

'This program will also run in QuickBasic, and you can have as
'many as 70 boxes open using far memory.  Just redim boxes to 70
'and start adding more boxes to your program. (depends on far mem)

'I re-coded this as a Qbasic program, because I remember when I
'was first starting out, I was disapointed because I thought that
'Qbasic was so limited in what it would do, that I became discouraged.
'(I didn't have a good conference like this for encouragement.:))
'And I keep seeing msg's from guys who don't have QB.
'Altho I certainly like QB better, there is still a lot that can
'be done in Qbasic as many here in the echo have found out.

'If anyone wants to see the QuickBasic version, just ask and
'I'll be glad to post it.  (It's a little faster, and doesn't
'use the SCREEN function)

DEFINT A-Z
DECLARE SUB shutup ()
DECLARE SUB KeyWait (dly%)
DECLARE SUB FastPrte (Row%, Col%, Buffer$, Attr%, Visible%)
DECLARE SUB PopUp (Row%, Col%, Widthe%, Height%, Attr%, Title$, Bdr%)
DECLARE SUB bPU (R%, c%, W%, H%, Fg%, Bg%, Title$, Bdr)
TYPE ScreenData          'if calling from another prog module
Row AS INTEGER        'use both of these 2 type def, in
Col AS INTEGER        'both calling and called program
Widthe AS INTEGER
Height AS INTEGER
Attr AS INTEGER
END TYPE
TYPE ScreenPram
Char AS STRING * 1
Attr AS STRING * 1
END TYPE
'I have not tried calling this version from another program, but
'it 'should' work just like the Quickbasic version:

'if called from another program, use the next 4 statements in order,
'in the call-ING program

'this goes in both programs:
COMMON SHARED SD() AS ScreenData, x() AS ScreenPram, scrnsUP  AS INTEGER

'next 3 declaractions not needed in the call-ED program
  
boxes% = 12   'this works for me.. if you have mem prob.. reduce this #
'and don't open as many boxes
'demo requires 12.. if you change this # be sure to
'save afterward to avoid out of string space errors.
DIM SHARED SD(boxes%) AS ScreenData
DIM SHARED x(1 TO boxes%, 25, 80)  AS ScreenPram

SCREEN 0: COLOR 7, 1: CLS
'FOR I = 0 TO 1997 STEP 2:   PRINT CHR$(3); : PRINT " "; : NEXT
FOR I = 0 TO 999 STEP 2:   PRINT CHR$(3); : PRINT " "; : NEXT
COLOR &HE
FOR I = 999 TO 1997 STEP 2:   PRINT CHR$(3); : PRINT " "; : NEXT

CALL bPU(2, 10, 50, 10, &HE, 4, Title$, 0)
Msg$ = "Show a box with no borders"
LOCATE 6, 22: COLOR &HE, 4: PRINT Msg$;
KeyWait 3

CALL bPU(4, 15, 50, 10, &H1E, 4, Title$, 2)
Msg$ = " Same box with blinking borders "
LOCATE 8, 25: COLOR &HE, 4: PRINT Msg$;
KeyWait 3

CALL bPU(6, 20, 50, 10, &HE, 4, Title$, 2)
Msg$ = " Same box with blinking text "
LOCATE 10, 31: COLOR &H1E, 4: PRINT Msg$;
KeyWait 3

Title$ = "Give it a Title"
CALL bPU(8, 25, 50, 10, &HE, &H9, Title$, 2)
Msg$ = " Change the Color "
LOCATE 12, 42: COLOR &H1E, 4: PRINT Msg$;
KeyWait 3

Title$ = "[Any title you want]"
KeyWait 3

Title$ = " Windows for QBasic!! "
CALL bPU(10, 10, 60, 5, &H5, &H7, Title$, 2)
Msg$ = " Watch out Bill Gates!!! "
LOCATE 12, 28: COLOR &H17, 5: PRINT Msg$;
KeyWait 3

Title$ = "[Full screen display]"
CALL bPU(1, 1, 80, 25, &HE, &H4, Title$, 2)
Msg$ = "As many as 16 boxes displayed at once!"
LOCATE 11, 24: COLOR &H1E, 4: PRINT Msg$;
Msg$ = "      All open at one time!!         "
LOCATE 12, 24: COLOR &H1E, 4: PRINT Msg$;
KeyWait 4
FOR I = 0 TO scrnsUP: shutup: NEXT

Title$ = "Small Window"
bPU 3, 6, 16, 5, &H6, &H3, Title$, 2
KeyWait 1
bPU 5, 8, 16, 5, &H6, &H0, Title$, 2
bPU 7, 10, 16, 5, &H6, &H1, Title$, 2
bPU 9, 12, 16, 5, &H6, &H2, Title$, 2
bPU 11, 14, 16, 5, &H6, &H3, Title$, 2
bPU 13, 16, 16, 5, &HE, &H4, Title$, 2
KeyWait 3

Title$ = "Larger Windows"
bPU 2, 30, 26, 10, 6, &H7, Title$, 2
KeyWait 1
bPU 4, 32, 26, 10, &HF, &H8, Title$, 2
bPU 6, 34, 26, 10, &H8, &H1, Title$, 2
bPU 8, 36, 26, 10, 9, &H2, Title$, 2
bPU 10, 38, 26, 10, &HA, &H3, Title$, 2
bPU 12, 40, 26, 10, &HB, &H4, Title$, 2
'bPU 14, 42, 26, 10, &HC, &H5, Title$, 1
'bPU 16, 44, 26, 10, &HD, &H6, Title$, 1
KeyWait 4
FOR I = 0 TO scrnsUP: shutup: NEXT

Title$ = "Popup just a centered message"
bPU 10, 22, 40, 1, &H4, &H3, Title$, 0
KeyWait dly%
Title$ = "Not bad for a Right Wing Redneck!!"
bPU 12, 22, 40, 1, &H4, &H3, Title$, 0
KeyWait dly%
Title$ = "Go-Pat-Go"
bPU 12, 22, 40, 1, &H4, &H3, Title$, 0
KeyWait dly%
FOR I = 0 TO scrnsUP: shutup: NEXT

Title$ = "<<<<< WOW >>>>>"
bPU 12, 21, 40, 1, &H7, &H4, Title$, 0   'this is neat.. it uses
Title$ = "It's all in Qbasic"            'the centered title to
bPU 13, 21, 40, 1, &H4, &H3, Title$, 0   'display a one liner
KeyWait dly%
FOR I = 0 TO scrnsUP: shutup: NEXT

FOR I = 8 TO 14
Title$ = "More exciting features to come!!!"
   bPU (I), 21, 40, 1, &HF, &H3, Title$, 0  'tip, put the i in ()
NEXT                                        'to keep it from getting
                                            'changed in the sub
KeyWait dly%
FOR I = 0 TO scrnsUP: shutup: NEXT   'closes all open boxes

bPU 8, 9, 64, 12, &HB, &H4, "By: Charles Godard", 2
RESTORE Credits:

FOR I = 9 TO 18
READ A$:
LOCATE (I), 11: COLOR &H4, 3: PRINT A$
NEXT
END
Credits:
DATA" Thanks to all in the  Qbasic conference for the good ideas "
DATA" The KeyWait SUB is from the discussions on the Delay timer "
DATA" Thanks to  *Gary Godard*  for the suggestions  relating to "
DATA" storing the screendata in a one byte string and for a good "
DATA" explanation of how multiple dimension array's work.        "
DATA"                                                            "
DATA" Alex Wellerstein and Bob Perkins discussions on the SCREEN "
DATA" Function,  opened my eyes  to what it would do and that is "
DATA" what gave me the idea to re-code this to Qbasic.   Since I "
DATA" already had it done in QB, it wasn't a big prob. to recode."

SUB bPU (R, c, W, H, Fg, Bg, Title$, Bdr)

scrnsUP = scrnsUP + 1
SD(scrnsUP).Row = R
SD(scrnsUP).Col = c
SD(scrnsUP).Widthe = W
SD(scrnsUP).Height = H
SD(scrnsUP).Attr = SCREEN(R + 1, c + 1, 1)

'store the screen
FOR Row = R TO R + H - 1
 FOR Col = c TO c + W - 1
 x(scrnsUP, Row, Col).Attr = CHR$(SCREEN(Row, Col, 1))
 x(scrnsUP, Row, Col).Char = CHR$(SCREEN(Row, Col))
 NEXT Col
NEXT Row

'put a box on the screen
FOR Row = R TO R + H - 1
COLOR Fg, Bg
LOCATE Row, c: PRINT STRING$(W, " ");
NEXT Row

'set up border styles
SELECT CASE Bdr
CASE IS = 1
bdrtl = 218: bdrtr = 191: bdrlc = 192: bdrrc = 217: 'corners
bdrv = 179: bdrh = 196:          'horizontal, vertical sides
CASE IS = 2
bdrtl = 201: bdrtr = 187: bdrlc = 200: bdrrc = 188: 'corners
bdrv = 186: bdrh = 205:          'horizontal, vertical sides
END SELECT

'? the corners to the box
COLOR Fg, Bg: LOCATE R, c: PRINT CHR$(bdrtl);
COLOR Fg, Bg: LOCATE R, c + W - 1: PRINT CHR$(bdrtr);
COLOR Fg, Bg: LOCATE R + H - 1, c: PRINT CHR$(bdrlc);
COLOR Fg, Bg: LOCATE R + H - 1, c + W - 1: PRINT CHR$(bdrrc);

'put the border sides around the box
'Lt side bdr
FOR Row = R + 1 TO R + H - 2
COLOR Fg, Bg
LOCATE Row, c
PRINT CHR$(bdrv);
NEXT Row
'Rt side bdr
FOR Row = R + 1 TO R + H - 2
COLOR Fg, Bg
LOCATE Row, c + W - 1
PRINT CHR$(bdrv);
NEXT Row
'top bdr
COLOR Fg, Bg
LOCATE R, c + 1
PRINT STRING$(W - 2, CHR$(bdrh));
'bottom bdr
COLOR Fg, Bg
LOCATE R + H - 1, c + 1
PRINT STRING$(W - 2, CHR$(bdrh));
 Center = c + (W - LEN(Title$)) \ 2
 LOCATE R, Center: PRINT Title$;
END SUB

SUB KeyWait (dly%)

IF dly% = 0 THEN dly% = 3
T& = TIMER
DO UNTIL ABS(TIMER - T&) > dly OR LEN(INKEY$): LOOP
END SUB

SUB shutup
IF scrnsUP < 1 THEN EXIT SUB
R = SD(scrnsUP).Row
c = SD(scrnsUP).Col
W = SD(scrnsUP).Widthe
H = SD(scrnsUP).Height
A = SD(scrnsUP).Attr

COLOR Fg, Bg
FOR Row = R TO R + H - 1
 FOR Col = c TO c + W - 1
 LOCATE Row, Col
 A = ASC(x(scrnsUP, Row, Col).Attr)
 Fg = A AND &HF
 Bg = (A \ &H10)
 COLOR Fg, Bg
 PRINT x(scrnsUP, Row, Col).Char;
 NEXT Col
NEXT Row
scrnsUP = scrnsUP - 1      'tracks the last open box which is still open

END SUB