home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
homonlib.zip
/
COLORSET.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-04-13
|
7KB
|
192 lines
DEFINT A-Z
' $INCLUDE: 'PARM.INC'
' $INCLUDE: 'SETCURS.INC'
' $INCLUDE: 'TRUEFALS.INC'
DECLARE FUNCTION ColorSet (hdr1$, hdr2$, parm(), defaults())
'External procedures:
DECLARE SUB Box (t, l, b, r, boxtype$)
DECLARE SUB Center (row, text$)
DECLARE FUNCTION GetKey$ (parm())
DECLARE SUB SetView (top, bot, parm())
DECLARE FUNCTION VPage (p)
DECLARE SUB Wipe (row)
DECLARE SUB WipeArea (t, l, b, r)
FUNCTION ColorSet (hdr1$, hdr2$, parm(), defaults())
'****************************************************************************
'A handy function to let the user set their color preferences.
'
'The hdr1$ and hdr2$ arugments are text strings that will be centered on the
' first two lines of the screen.
'
'The parm() array will be directly modified by ColorSet(). The function will
' return TRUE if any of the colors were changed, FALSE if they are the same
' as when the function was entered. This is useful if the calling program
' needs to know whether to save the new values in some sort of a setup file
' or not.
'
'The defaults() array should mimic the parm() array. It must have subscripts
' ranging from MINCOLOR to MAXCOLOR at least.
'
'Because this function changes colors and has to mess with the screen a bit,
' it does not restore the previous screen or viewport upon exiting. The
' procedure that calls this function must know to repaint the screen and
' restore any active viewport upon returning.
'
'****************************************************************************
REDIM orig(MINCOLOR TO MAXCOLOR) 'Copy the current values for a
FOR x = MINCOLOR TO MAXCOLOR 'restore to previous request.
orig(x) = parm(x)
NEXT x
REDIM lbl$(MINCOLOR TO MAXCOLOR) 'Define the text labels:
lbl$(FGN) = "Normal foreground.... "
lbl$(BGN) = "Normal background.... "
lbl$(FGH) = "Highlighted fg....... "
lbl$(FGD) = "Dimmed fg............ "
lbl$(FGS) = "Selected fg.......... "
lbl$(BGS) = "Selected bg.......... "
lbl$(FGDS) = "Dimmed Selected fg... "
lbl$(FGWB) = "Window Border fg..... "
lbl$(BGWB) = "Window Border bg..... "
lbl$(FGWT) = "Window Text fg....... "
lbl$(BGWT) = "Window Text bg....... "
lbl$(FGWS) = "Window Selected fg... "
lbl$(BGWS) = "Window Selected bg... "
REDIM bgmax(MINCOLOR TO MAXCOLOR) 'Limit the color values to 0-15
FOR x = MINCOLOR TO MAXCOLOR 'for foregrounds and 0-7 for
bgmax(x) = 15 'backgrounds.
NEXT x
bgmax(BGN) = 7
bgmax(BGS) = 7
bgmax(BGWB) = 7
bgmax(BGWS) = 7
bgmax(BGWT) = 7
workpage = VPage(0) 'Allocate a video page
oldcursor = SetCursor(SCNONE) 'Turn the cursor off
COLOR 7, 0 'Get a clean, black screen.
VIEW PRINT: CLS
Center 1, hdr1$ 'Print the text that doesn't
Center 2, hdr2$ 'ever change:
LOCATE 3, 1
PRINT STRING$(80, 205)
VIEW PRINT 4 TO 24
LOCATE 5, 22: PRINT "Set: Prev: Default:"
FOR x = MINCOLOR TO MAXCOLOR
PRINT lbl$(x); TAB(30);
PRINT USING "## ##"; orig(x); defaults(x)
NEXT x
Box 4, 45, 22, 80, "1"
Wipe 24
PRINT CHR$(24); CHR$(25); " = Select field ";
PRINT "l/r = Change value P)revious D)efault ESC = Done";
refresh = TRUE 'Set up for the main loop.
sel = MINCOLOR
DO
IF refresh THEN 'Update the color examples only
SCREEN , , workpage, 0 'when they get changed.
PCOPY 0, workpage
COLOR parm(FGN), parm(BGN)
WipeArea 5, 46, 21, 79
LOCATE 6, 51: PRINT " Normal Text "
COLOR parm(FGH)
LOCATE 8, 51: PRINT " Highlighted Text "
COLOR parm(FGD)
LOCATE 10, 51: PRINT " Dimmed Text "
COLOR parm(FGS), parm(BGS)
LOCATE 12, 51: PRINT " Normal Selected Text "
COLOR parm(FGDS)
LOCATE 14, 51: PRINT " Dimmed Selected Text "
COLOR parm(FGWB), parm(BGWB)
Box 16, 50, 19, 75, ""
COLOR 0, 0
FOR x = 17 TO 19
LOCATE x, 76
PRINT " "
NEXT x
LOCATE 20, 51
PRINT SPACE$(26)
COLOR parm(FGWT), parm(BGWT)
LOCATE 17, 51: PRINT " Window Text "
LOCATE 18, 51: PRINT " "
COLOR parm(FGWS), parm(BGWS)
LOCATE 18, 54: PRINT " Window Selection "
PCOPY workpage, 0
SCREEN , , 0, 0
COLOR 7, 0
refresh = FALSE
END IF
row = 6 'Show the current parm() values.
FOR x = MINCOLOR TO MAXCOLOR
LOCATE row, 23
IF x = sel THEN COLOR 0, 7
PRINT USING "##"; parm(x)
COLOR 7, 0
row = row + 1
NEXT x
'Get keyboard input:
SELECT CASE UCASE$(GetKey$(parm()))
CASE CHR$(27) 'ESC
EXIT DO
CASE CHR$(0) + CHR$(72) 'Up arrow
sel = sel - 1
CASE CHR$(0) + CHR$(80) 'Down arrow
sel = sel + 1
CASE CHR$(0) + CHR$(75) 'Left arrow (-)
parm(sel) = parm(sel) - 1
refresh = TRUE
CASE CHR$(0) + CHR$(77) 'Right arrow (+)
parm(sel) = parm(sel) + 1
refresh = TRUE
CASE "P" 'Previous
FOR x = MINCOLOR TO MAXCOLOR
parm(x) = orig(x)
NEXT x
refresh = TRUE
CASE "D" 'Default
FOR x = MINCOLOR TO MAXCOLOR
parm(x) = defaults(x)
NEXT x
refresh = TRUE
CASE ELSE
'Do nothing
END SELECT
IF sel < MINCOLOR THEN sel = MAXCOLOR
IF sel > MAXCOLOR THEN sel = MINCOLOR
IF parm(sel) < 0 THEN parm(sel) = bgmax(sel)
IF parm(sel) > bgmax(sel) THEN parm(sel) = 0
LOOP
FOR x = MINCOLOR TO MAXCOLOR 'See if anything changed.
IF parm(x) <> orig(x) THEN
ColorSet = TRUE
EXIT FOR
END IF
NEXT x
ERASE orig 'Release the temporary arrays.
ERASE lbl$
ERASE bgmax
x = VPage(workpage) 'Release the video page.
x = SetCursor(oldcursor) 'Restore the previous cursor value.
COLOR parm(FGN), parm(BGN) 'Set the colors to normal.
END FUNCTION