Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB3SMG2.ZIP
Filename : SMGCOLOR.PRG

** THIS PROGRAM WAS ADAPTED FROM THE PUBLIC DOMAIN PROGRAM CALLED COLOR3P.PRG
** THERE WAS NO AUTHOR LISTED ON THE VERSION I HAD SO I DO NOT KNOW WHO TO
** THANK FOR PROVIDING THE CODE.
** REM IF YOU USE THIS AS A STAND ALONE PROGRAM YOU MUST SET TALK OFF
N_COLOR=[G+/N]
ZROW=2
SET COLO TO &N_COLOR
CLEAR
@ 0,18 TO 2,62 DOUBLE
@ 1,20 say [C O L O R S E L E C T I O N M E N U]
* screen display of color choices
SET COLO TO N/W
@ ZROW+1,5 SAY [ ZERO IS BLACK ]
SET COLO TO B/N
@ ZROW+2,5 SAY [COLOR CHOICE 01]
SET COLO TO G
@ ZROW+3,5 SAY [COLOR CHOICE 02]
SET COLO TO BG
@ ZROW+4,5 SAY [COLOR CHOICE 03]
SET COLO TO R
@ ZROW+5,5 SAY [COLOR CHOICE 04]
SET COLO TO RB
@ ZROW+6,5 SAY [COLOR CHOICE 05]
SET COLO TO GR
@ ZROW+7,5 SAY [COLOR CHOICE 06]
SET COLO TO W
@ ZROW+8,5 SAY [COLOR CHOICE 07]
SET COLO TO N/W
@ ZROW+9,5 SAY [ 08 IS BLACK ]
SET COLO TO B+
@ ZROW+10,5 SAY [COLOR CHOICE 09]
SET COLO TO G+
@ ZROW+11,5 SAY [COLOR CHOICE 10]
SET COLO TO BG+
@ ZROW+12,5 SAY [COLOR CHOICE 11]
SET COLO TO R+
@ ZROW+13,5 SAY [COLOR CHOICE 12]
SET COLO TO RB+
@ ZROW+14,5 SAY [COLOR CHOICE 13]
SET COLO TO GR+
@ ZROW+15,5 SAY [COLOR CHOICE 14]
SET COLO TO W+
@ ZROW+16,5 SAY [COLOR CHOICE 15]
SET COLO TO G/N
STOR 0 TO ZF1,ZF2,ZB1,ZB2
DO WHILE .T.
* get user choices
STORE 0 TO ZF1,ZF2,ZB1,ZB2,ZBD1,ZBD2
@5,25 SAY [Choose STANDARD foreground color: ]
@5,64 GET ZF1 PICTURE '99'RANGE 0,15
@6,25 SAY [Choose STANDARD background color: ]
@6,64 GET ZB1 PICTURE '99'RANGE 0,15
@8,25 SAY [Choose ENHANCED foreground color: ]
@8,64 GET ZF2 PICTURE '99'RANGE 0,15
@9,25 SAY [Choose ENHANCED background color: ]
@9,64 GET ZB2 PICTURE '99'RANGE 0,15
@11,25 SAY [Choose BORDER MENU foreground color: ]
@11,64 GET ZBD1 PICTURE '99'RANGE 0,15
@12,25 SAY [Choose BORDER MENU background color: ]
@12,64 GET ZBD2 PICTURE '99'RANGE 0,15
READ
IF ZF1=ZB1 .OR. ZF2=ZB2
SET COLO TO W+/N
?? CHR(7) + CHR(7) + CHR(7)
@ 19,25 SAY [You have selected matching foreground and]
@ 20,25 SAY [background colors. Nothing will show on ]
@ 21,25 say [your screen display. Please re-enter ]
@ 22,25 say [your selections.]
SET COLO TO G+/N
LOOP
ELSE
* set up memvars with color statement using user choices
@ 19,0 CLEAR
@ 19,25 SAY "Working ..."
CNT = 1
S = LTRIM(STR(CNT))
CO&S = ' '
DO WHILE CNT < 7
DO CASE
CASE ZF1=0
ZF1S=[N]
CASE ZF1=1
ZF1S=[B]
CASE ZF1=2
ZF1S=[G]
CASE ZF1=3
ZF1S=[BG]
CASE ZF1=4
ZF1S=[R]
CASE ZF1=5
ZF1S=[RB]
CASE ZF1=6
ZF1S=[GR]
CASE ZF1=7
ZF1S=[W]
CASE ZF1=8
ZF1S=[N+]
CASE ZF1=9
ZF1S=[B+]
CASE ZF1=10
ZF1S=[G+]
CASE ZF1=11
ZF1S=[BG+]
CASE ZF1=12
ZF1S=[R+]
CASE ZF1=13
ZF1S=[RB+]
CASE ZF1=14
ZF1S=[GR+]
CASE ZF1=15
ZF1S=[W+]
ENDCASE
DO CASE
CASE CNT = 1
CO&S = ZF1S
ZF1 = ZB1
CASE CNT = 2
CO&S = ZF1S
ZF1 = ZF2
CASE CNT = 3
CO&S = ZF1S
ZF1 = ZB2
CASE CNT = 4
CO&S = ZF1S
ZF1 = ZBD1
CASE CNT = 5
CO&S = ZF1S
ZF1 = ZBD2
CASE CNT = 6
CO&S = ZF1S
ENDCASE
CNT = CNT + 1
S = LTRIM(STR(CNT))
LOOP
ENDDO
*establish color combinations and load macro-memvars
N_COLOR=CO1+[/]+CO2+[,]+CO3+[/]+CO4
R_COLOR=CO3+[/]+CO4+[,]+CO1+[/]+CO2
B_COLOR=CO5+[/]+CO6
*use the macro function to set colors
SET COLOR TO &N_COLOR
@ 19,25 SAY [This is the STANDARD color you selected.]
SET COLO TO &R_COLOR
@ 20,25 say [This is the ENHANCED color you selected.]
SET COLO TO &B_COLOR
@ 21,25 SAY [This is the MENU BORDER color you selected.]
SET COLO TO &N_COLOR
ZOK=[Y]
@ 22,25 SAY [Do you want to install these colors? Y/N ]
@ 22,67 GET ZOK
READ
IF ZOK=[Y] .OR. ZOK=[y]
EXIT
ELSE
SET COLO TO G/N,N/W+
M_WAIT = ' '
@ 24,25 SAY [Any key to re-enter a color selection] GET M_WAIT
READ
CLEAR GETS
@ 19,0 CLEAR
LOOP
ENDIF
ENDIF
ENDDO
SET COLOR TO &N_COLOR
RELEASE ALL LIKE Z*
RELEASE M_WAIT
RETURN
*****