Category : BASIC Source Code
Archive   : ALIB.ZIP
Filename : BOXES-U.BAS

'==============================================================================
' ALL-PURPOSE LIBARY
'
' THE FOURTH UNIT -- BOXES-U.BAS
'==============================================================================
' -- 2-18-90
' H Ballinger
$COMPILE UNIT
$ERROR ALL OFF


DEFINT A-Z
%Center = 0

EXTERNAL RD$, ColorDisplay, NeedDCon, FlashBox
EXTERNAL BoxColor, FldColor, WinColor, CursorTop, CursorBottom, Ln, Col
EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
EXTERNAL LocalAreaCode$, Record%
EXTERNAL BXScreenSaved, PMScreenSaved
EXTERNAL FieldName$(), FieldMask$(), FL(), FC(), Fields%


SUB BOXMESSAGE(CornerLin, CornerCol, Margin) PUBLIC
' ==== Boxes and displays your message.
' Top L. corner will be at the designated coordinates,
' but errors are trapped so box will stay on the
' screen regardless. The message line should appear
' in your code as DATA statements, terminated by
' "END". A RESTORE statement is needed, of course.
' See HBDEMO.BAS for examples & comments.

LOCAL I$(), MaxL, Items%, D$

LOCATE ,,0 ' extinguish the cursor
BReadlines:
DIM I$(23) ' each I$ is a msg line; # of lines is Items%
READ D$
WHILE D$ <> "END" AND Items% < 23 ' (from data list)
INCR Items% ' count 1 item
I$(Items%) = D$ ' plug the data into array
IF LEN(D$) > MaxL THEN MaxL = LEN(D$) ' MaxL = length of longest I$()
READ D$ ' ... and repeat.
WEND

CALL BOXMESSAGE2 (CornerLin, CornerCol, Margin, I$(), Items%, MaxL)
END SUB REM BOXMESSAGE
'______________________________________________________________________________

SUB BOXMESSAGE2 (CornerLin, CornerCol, Margin, I$(1), Items%, MaxL) PUBLIC

' Use this call if you wish to set text lines -- I$() -- at runtime instead
' of using DATA statements ...

LOCAL Wid, Height, I, P, Y, Z, F, Bar$

BSetVars:
Items% = MIN (Items%, 23) ' can't contain > 23 limes of text.
Margin = MIN ((23 - Items%) / 2, Margin) ' if margin too big, reduce.

Wid = MaxL + 4 + 4*Margin ' Total width of box: length of longest text
' string + 2 for sides, 4 for spaces, and 4
' for each unit of margin (2 each side).

Items% = MIN (Items%, 23)
Margin = MIN ((23 - Items%) / 2, Margin)

Height = Items% + 2 + 2*Margin ' Height: add 2 for each unit of margin
Wid = MIN (Wid, 80)
Height = MIN (Height, 25)

IF CornerCol = %Center THEN CornerCol = 41 - Wid / 2 ' horiz centering ...

CornerCol = MIN (CornerCol, 81 - Wid) ' If CornerCol + Wid > 80, fix it.

CornerCol = MAX (CornerCol, 1) ' CornerCol not < 1.


IF CornerLin = %Center THEN CornerLin = 13 - Height / 2

CornerLin = MIN (CornerLin, 26-Height)

CornerLin = MAX (1, CornerLin)
' error traps keep box on screen

Bar$ = "\"+SPACE$(Wid-4)+"\" ' set a line mask

BPrint:
LOCATE CornerLin, CornerCol
I = BoxColor MOD 16
P = BoxColor \ 16 ' set local variables for colors and
F = FlashBox * -16 ' if box to flash, let F = 16
COLOR I + F , P
' print top bar
PRINT CHR$(201);: PRINT STRING$ ((Wid-2), 205);: PRINT CHR$ (187);
Z = CornerLin+1

IF Margin > 0 THEN
FOR Y = 1 TO Margin
LOCATE Z ,CornerCol
COLOR I + F , P : PRINT CHR$(186);: COLOR I , P
PRINT USING Bar$;" ";
COLOR I + F , P : PRINT CHR$(186);: COLOR I , P
INCR Z
NEXT
END IF
'
' print message lines
FOR Y = 1 TO Items%
LOCATE Z,CornerCol
COLOR I + F , P : PRINT CHR$(186);: COLOR I , P ' print border char.
PRINT USING BAR$; SPACE$(2*Margin + (MaxL-Len(I$(Y))) / 2 + .9) + I$(Y);
' count off enough spaces to center the characters then print 'em ...
COLOR I + F , P : PRINT CHR$(186); ' and print right hand border.
INCR Z
NEXT

IF Margin THEN ' print appropriate # of blank lines for margin
FOR Y = 1 TO Margin
LOCATE Z,CornerCol
COLOR I + F , P : PRINT CHR$(186);: COLOR I , P
PRINT USING Bar$;" ";
INCR Z
COLOR I + F , P : PRINT CHR$(186);
NEXT
END IF
' print bottom bar
LOCATE Z, CornerCol, 1: PRINT CHR$ (200);: PRINT STRING$ ((Wid-2), 205);
PRINT CHR$(188);
COLOR I , P
FlashBox = 0


END SUB REM BOXMESSAGE2

' =============================================================================


SUB POPWINDOW PUBLIC ' print a data entry window ...
' and set up its lookup table

LOCAL X, Y, Z, Title$, CornerCol, CornerLin, Prompt$, Ht, A$
COLOR WinColor MOD 16, WinColor \ 16
READ A$: Wid = VAL(A$)
READ A$: CornerLin = VAL(A$)
READ A$: CornerCol = VAL(A$)
READ A$: Ht = VAL(A$)
' print top of window ...
LOCATE CornerLin, CornerCol: PRINT CHR$(201);
PRINT STRING$((Wid-2),205);: PRINT CHR$(187);

FOR Z = CornerLin+1 TO CornerLin+Ht-2 ' sides ...
LOCATE Z, CornerCol: PRINT CHR$(186);SPACE$(Wid-2); CHR$(186);
NEXT Z
' ... print bottom bar.
LOCATE Z, CornerCol:PRINT CHR$(200);
PRINT STRING$((Wid-2),205);: PRINT CHR$(188);

READ Prompt$, X, Y ' place prompts in window (you hope ...)
DO
LOCATE X, Y: PRINT Prompt$
READ Prompt$: IF Prompt$ <> "END" THEN READ X, Y
LOOP UNTIL Prompt$ = "END"

COLOR FldColor MOD 16, FldColor \ 16

Z=1

READ FieldName$(Z),FieldMask$(Z),FL(Z),FC(Z) ' create the table for
' this record data window
DO
LOCATE FL(Z),FC(Z)
PRINT SPACE$ (LEN(FieldMask$(Z))) ' print a blank field ...
INCR Z
READ FieldName$(Z)
IF FieldName$(Z) <> "END" THEN READ FieldMask$(Z), FL(Z), FC(Z)
LOOP UNTIL FieldName$(Z) = "END"


Fields% = Z-1

END SUB

' ----------------------------------------------------------------------------


SUB PWSetUp (Fld$,Z) PUBLIC ' sets up to ENTER a record field at the right
' location in a pop-up data record window using the
' lookup table (FieldName$() etc.). When a match is
' found the cursor is placed. The subscript # used
' is returned as the parameter Z.

Z = 1

DO UNTIL FieldName$(Z) = Fld$ 'find fld name in table
INCR Z
IF Z > Fields% THEN
BEEP
LOCATE 25,1
PRINT " PWSetUp error: window for "+Fld$+" not open !!! "
DO: LOOP UNTIL INKEY$ <> ""
END 1
END IF
LOOP

LOCATE FL(Z), FC(Z)
COLOR FldColor MOD 16, FldColor \ 16

END SUB REM PWSetUp

' =========================================================================

SUB QBOX (L%, C%, Lines%, Message$, AnsFldLength) PUBLIC

LOCAL I$(), AFCol, AFLin, Items, MaxL
DIM I$(4)
AnsFldLength = MIN (AnsFldLength, 75) ' trim excessive ans length

IF Lines% > 1 THEN
' THREE LINE Q-BOX
IF L = %Center THEN L = 11
L = MIN (L, 21)
Message$ = LEFT$ (Message$, 76) ' trim excessive prompt
I$(1) = Message$
Items% = 3
I$(2) = " "
I$(3) = " "
MaxL = MAX (LEN (Message$), AnsFldLength)
IF C = %Center THEN C = FIX ((76 - MaxL) / 2)
C = MIN (C, 76 - MaxL)
AFCol = C + 2
IF LEN(Message$) > AnsFldLength THEN
AFCol = C + 2 + (LEN(Message$)-AnsFldLength)/2
END IF
AFLin = L + 3

ELSE
' ONE LINE Q-BOX:
' if it's all too long, trim prompt ...
Message$ = LEFT$ (Message$, 75 - AnsFldLength)
IF C = %Center THEN C = (80 - LEN (Message$) - AnsFldLength) / 2
IF L = %Center THEN L = 12
I$(1) = Message$ + SPACE$ (AnsFldLength + 1)
Items% = 1
' if C + box width > 80, decrease it to fit
C = MIN (C, 76 - LEN(Message$) - AnsFldLength)
AFCol = C + 3 + LEN (Message$)

AFLin = MIN (L+1, 24)
MaxL = LEN(Message$) + AnsFldLength + 1

END IF

CALL BOXMESSAGE2 (L,C,0,I$(),Items%,MaxL)

LOCATE AFLin,AFCol,1
END SUB

' exit with cursor set correctly at the end of the prompt$ so you
' can immediately call a keyboard input routine like those in FENTRY-U.

' --------------------------------------------------------------------------
SUB Marker2 (Z$)
LOCAL L, C
L = CSRLIN: C = POS
LOCATE 1,1: PRINT ">>>>>>> "; Z$; " <<<<<<<<"
DO: LOOP UNTIL INKEY$ <> ""
LOCATE L,C
END SUB