home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
homonlib.zip
/
PANES.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-04-13
|
7KB
|
155 lines
DEFINT A-Z
' $INCLUDE: 'TRUEFALS.INC'
DECLARE SUB Box (row1, col1, row2, col2, boxtype$)
DECLARE SUB Panes (row1, col1, row2, col2, row3, col3, boxtype$)
'External Procedures:
DECLARE FUNCTION IsAlpha (s$)
SUB Box (row1, col1, row2, col2, boxtype$)
'****************************************************************************
'Draws a box on the screen at the specified coordinates. row1 & col1 are the
' top left corner, row2 & col2 are the bottom right corner. The appearance
' of the box is determined by boxtype$, which can either be one character to
' pick a predefined box type or a string of 11 or more characters to be used
' as the actual box characters. See the function body of Panes() for the
' exact placement of the characters within the string and other options.
'
'Examples of boxtype$: "1" or "S" Draws a single-line box (default)
' "2" or "D" Draws a double-line box
' "3" or "H" Double Horizontal lines, single vertical
' "4" or "V" Double Vertical lines, single horizontal
' "***********" Draws a box made of asterisks
'
'****************************************************************************
'Translate the call to Box() into a call to Panes() with no inner lines.
Panes row1, col1, row2, col2, 0, 0, boxtype$
END SUB
SUB Panes (row1, col1, row2, col2, row3, col3, boxtype$)
'****************************************************************************
'Draws a box on the screen at the specified coordinates. row1 & col1 are the
'top left corner, row2 & col2 are the bottom right corner. row3 & col3 are
'parameters specifying where the box is to be split horizontally and/or
'vertically. If either or both row3 or col3 are zero, the box will not be
'split in that direction. Experiment with it.
'
'The appearance of the box is determined by boxtype$, which can either be one
'character to pick a predefined box type or a string of 11 or more characters
'to be used as the actual box characters. See the function body for the
'exact placement of the characters within the string.
'
'Examples of boxtype$: "1" or "S" Draws a single-line box (default)
' "2" or "D" Draws a double-line box
' "3" or "H" Double horizontal lines, single vertical
' "4" or "V" Double vertical lines, single horizontal
' "***********" Draws a box made of asterisks
'
'The box can be drawn as an outline only, not overwriting anything within the
' box's borders or can be filled with a fill character, effectively placing
' the box over whatever was already there. This option is also controlled by
' the boxtype$ argument:
'
'If boxtype$ is specified as a number ("1", "2"...) the box will be drawn as
' an outline only. If boxtype$ is specified as a letter ("S", "D"...) the
' box will be filled with spaces.
'
'If boxtype is a user-supplied string of characters, if it's length is 12 or
' more, the 12th character will be used as the fill character, otherwise the
' box will be drawn as an outline.
'
'****************************************************************************
' *** Define the box characters ***
x$ = "┌┐┘└│─┬┤┴├┼" 'Default the box characters to single line
IF LEN(boxtype$) >= 11 THEN 'User-supplied
x$ = boxtype$ 'box characters
ELSE
SELECT CASE UCASE$(LEFT$(boxtype$, 1))
CASE "2", "D" 'Double
x$ = "╔╗╝╚║═╦╣╩╠╬"
CASE "3", "H" 'Horizontal dbl.
x$ = "╒╕╛╘│═╤╡╧╞╪"
CASE "4", "V" 'Vertical dbl.
x$ = "╓╖╜╙║─╥╢╨╟╫"
CASE ELSE 'Single (default)
'Use the pre-defined value of x$
END SELECT
IF IsAlpha(boxtype$) THEN 'Fill the box if
x$ = x$ + " " 'boxtype$ is a
END IF 'letter.
END IF
' *** Give descriptive names to the box characters ***
tlc$ = MID$(x$, 1, 1) 'Top Left Corner
trc$ = MID$(x$, 2, 1) 'Top Right Corner
brc$ = MID$(x$, 3, 1) 'Bottom Right Corner
blc$ = MID$(x$, 4, 1) 'Bottom Left Corner
ver$ = MID$(x$, 5, 1) 'Vertical line
hor$ = MID$(x$, 6, 1) 'Horizontal line
tx$ = MID$(x$, 7, 1) 'Top intersection
rx$ = MID$(x$, 8, 1) 'Right intersection
bx$ = MID$(x$, 9, 1) 'Bottom intersection
lx$ = MID$(x$, 10, 1) 'Left intersection
mx$ = MID$(x$, 11, 1) 'Middle intersection
IF LEN(x$) > 11 THEN 'Fill character?
f$ = MID$(x$, 12, 1)
fill = TRUE
END IF
' *** Draw the Box ***
wide = col2 - col1 - 1
across$ = STRING$(wide, hor$) 'Call STRING$ only
IF fill THEN f$ = STRING$(wide, f$) 'one time each.
LOCATE row1, col1 'The main box outline:
PRINT tlc$; across$; trc$; 'The top line
FOR x = (row1 + 1) TO (row2 - 1) 'The sides
LOCATE x, col1
PRINT ver$;
IF fill THEN 'If the box is being
PRINT f$; ver$; 'filled, put the fill
ELSE 'characters between
LOCATE x, col2 'the sides. Otherwise
PRINT ver$; 'just skip that area.
END IF
NEXT x
LOCATE row2, col1 'The bottom line
PRINT blc$; across$; brc$;
IF row3 > 0 THEN 'Split horizontally?
LOCATE row3, col1
PRINT lx$; across$; rx$;
END IF
IF col3 > 0 THEN 'Split vertically?
LOCATE row1, col3
PRINT tx$;
FOR x = (row1 + 1) TO (row2 - 1)
LOCATE x, col3
PRINT ver$;
NEXT x
LOCATE row2, col3
PRINT bx$;
END IF
IF row3 > 0 AND col3 > 0 THEN 'Split both ways?
LOCATE row3, col3
PRINT mx$
END IF
END SUB