Category : Recently Uploaded Files
Archive   : BASIC1A.ZIP
Filename : COLORSET.BAS

DEFINT A-Z
CLS
ScrColor = &H02
BoxColor = &H4E

LOCATE ,,0

' Code to write Static Window {colorset} to Screen
' note: created by StatWindow Writer (SWW) from colorset.SW

COLOR BoxColor MOD 16, BoxColor \ 16
LOCATE 3, 5
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
LOCATE 4, 5
PRINT "³ ³";
LOCATE 5, 5
PRINT "³ COLORSET is a part of the HB All-Purpose library for Power ³";
LOCATE 6, 5
PRINT "³ Basic programming. One of the features included is making ³";
LOCATE 7, 5
PRINT "³ your PB programs color-customizable by the end user. ³";
LOCATE 8, 5
PRINT "³ COLORSET.BAS, once compiled, automates the process of ³";
LOCATE 9, 5
PRINT "³ writing command line switches to reset the colors of the ³";
LOCATE 10, 5
PRINT "³ Demo (or any PB program that uses the SetColors routine). ³";
LOCATE 11, 5
PRINT "³ Start it and follow directions! The program will end up ³";
LOCATE 12, 5
PRINT "³ writing a batch file (name is entered at runtime) to start ³";
LOCATE 13, 5
PRINT "³ a PB exe file (likewise) in the colors chosen onscreen. ³";
LOCATE 14, 5
PRINT "³ ³";
LOCATE 15, 5
PRINT "³ (Thanks to Barry Erick of Spectra support for giving his ³";
LOCATE 16, 5
PRINT "³ OK to recycle his elegant color selector procedure as the ³";
LOCATE 17, 5
PRINT "³ kernel of COLORSET.) ³";
LOCATE 18, 5
PRINT "³ -- Howard Ballinger ³";
LOCATE 19, 5
PRINT "³ 9-8-90 ³";
LOCATE 20, 5
PRINT "³ PRESS ANY KEY ³";
LOCATE 21, 5
PRINT "³ [Esc] to Quit ³";
LOCATE 22, 5
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ";

' 09-08-1990, 11:13: end of StatWindow generated code for window {colorset}

COLOR ScrColor MOD 16, ScrColor \ 16
DO: K$ = INKEY$: LOOP UNTIL K$ <> ""
IF K$ = CHR$ (27) THEN PRINT: PRINT: PRINT "OK, Ending Here.": STOP

ScrColor = &H02
WinColor = &H71
FldColor = &H2F
MenuColor = &H03
BarColor = &H1F
BoxColor = &H3A

Start:
COLOR ScrColor MOD 16, ScrColor \ 16
CLS: LOCATE 12,5: PRINT "THIS IS THE SCREEN BACKGROUND COLOR"
LOCATE 2,20: PRINT "COLOR SELECT FOR HB / POWER BASIC PROGRAMS"
LOCATE 3,21: PRINT "========================================"

LOCATE 19,25: PRINT "ÉÍÍÍÍÍÍ»
LOCATE 20,25: PRINT "ºBUTTONº
LOCATE 21,25: PRINT "ÈÍÍÍÍÍͼ

COLOR MenuColor MOD 16, MenuColor \ 16
LOCATE 14,3: PRINT "ÉÍ sample menu Í»"
LOCATE 15,3: PRINT "º 1 - Machaut º"
LOCATE 16,3: PRINT "º 2 - Lassus º"
LOCATE 17,3: PRINT "º 3 - Des Prez º"
LOCATE 18,3: PRINT "º 4 - Palestrinaº"
LOCATE 19,3: PRINT "º 5 - Holborne º"
LOCATE 20,3: PRINT "º 6 - Tallis º"
LOCATE 21,3: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"


COLOR BarColor MOD 16, BarColor \ 16
LOCATE 15,4: PRINT " 1 - Machaut "

COLOR WinColor MOD 16, WinColor \ 16
LOCATE 14,37: PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
LOCATE 15,37: PRINT "º SAMPLE DATA ENTRY WINDOW º
LOCATE 16,37: PRINT "º º
LOCATE 17,37: PRINT "º Year: 1610 Form: Gaillard º
LOCATE 18,37: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ

COLOR FldColor MOD 16, FldColor \ 16
LOCATE 17, 46: PRINT "1610"
LOCATE 17, 60: PRINT "Gaillard "

COLOR BoxColor MOD 16, BoxColor \ 16
LOCATE 20,48: PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
LOCATE 21,48: PRINT "º SAMPLE MESSAGE BOX º
LOCATE 22,48: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ


LOCATE 24,1
COLOR 15,0
PRINT " 1: Menu / 2: Menu Select Bar / 3: Window / 4: Data Fields in Window ";
LOCATE 25,1
PRINT " 5: Message-Dialog Boxes / 6: Screen Background & Buttons / [Esc]: QUIT ";

LOCATE 23,1,1: COLOR 14,0: PRINT "Which color do you want to set ? ";
DO
Choice$ = INKEY$
IF Choice$ = "" THEN Choice$ = "0"
LOOP UNTIL (INSTR ("123456", Choice$) > 0) OR Choice$ = CHR$(27)

LOCATE 23,1,0: PRINT " "
LOCATE 24,1: PRINT SPACE$ (79);
LOCATE 25,1: PRINT SPACE$ (79);
SELECT CASE Choice$
CASE "1"
LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MENU COLOR";
F = MenuColor MOD 16: B = MenuColor \ 16
GOSUB GetChoice
MenuColor = F + 16*B
EXIT SELECT
CASE "2"
LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MENU SELECTION BAR COLOR";
F = BarColor MOD 16: B = BarColor \ 16
GOSUB GetChoice
BarColor = F + 16*B
EXIT SELECT
CASE "3"
LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR DATA ENTRY WINDOW COLOR";
F = WinColor MOD 16: B = WinColor \ 16
GOSUB GetChoice
WinColor = F + 16*B
EXIT SELECT
CASE "4"
LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR DATA ENTRY FIELD COLOR";
F = FldColor MOD 16: B = FldColor \ 16
GOSUB GetChoice
FldColor = F + 16*B
EXIT SELECT
CASE "5"
LOCATE 24,10: COLOR 31,0: PRINT "SELECT YOUR MESSAGE / DIALOG BOX COLOR";
F = BoxColor MOD 16: B = BoxColor \ 16
GOSUB GetChoice
BoxColor = F + 16*B
EXIT SELECT
CASE "6"
LOCATE 24,10: COLOR 31,0
PRINT "SELECT YOUR OVERALL SCREEN & BUTTON COLOR";
F = ScrColor MOD 16: B = ScrColor \ 16
GOSUB GetChoice
ScrColor = F + 16*B
EXIT SELECT
CASE CHR$ (27)
LOCATE 5,1
L$ = "ScrC="+FnHEX2$ (ScrColor)+_
" MnuC="+FnHEX2$ (MenuColor)+_
" BarC="+FnHEX2$ (BarColor)+_
" WinC="+FnHEX2$ (WinColor)+_
" FldC="+ FnHEX2$ (FldColor)+_
" BoxC="+FnHEX2$ (BoxColor)
PRINT "the parameter string is: ";L$
COLOR ScrColor MOD 16, ScrColor \ 16
PrepareBatFile:
LOCATE 6,1
PRINT " IF YOU WANT TO CREATE A BATCH FILE, ENTER ITS NAME (no ext) "
INPUT " (TO SKIP, JUST PRESS [ENTER]). FileName ";BatName$
IF BatName$ <> "" THEN
P = INSTR (BatName$, ".")
IF P THEN BatName$ = LEFT$ (BatName$, P-1)
BatName$ = UCASE$ (LEFT$ (BatName$, 8))
LOCATE 8,1
PRINT " NAME OF POWER-BASIC EXE PROGRAM TO BE STARTED IN NEW COLORS"
PRINT " BY THE BATCH FILE ";BatName$ + ".BAT ?? (no ext) ";
INPUT ExeName$
P = INSTR (ExeName$, ".")
IF P THEN ExeName$ = LEFT$ (ExeName$, P-1)
ExeName$ = LEFT$ (ExeName$, 8)
IF ExeName$ = BatName$ THEN
LOCATE 8,10
PRINT "THE FILE NAMES CAN'T BE THE SAME ";
PRINT "OR DOS WON'T KNOW WHICH ONE TO START !"
PLAY "O0 C4": DO: LOOP UNTIL INKEY$ <> ""
GOTO Start
END IF
ON ERROR GOTO Oops
OPEN BatName$ + ".BAT" FOR OUTPUT AS #1
PRINT #1, "echo off"

PRINT #1, ExeName$ + " " + L$
PRINT #1, ": this batch file created by SETCOLOR.BAS to run " + ExeName$
CLOSE #1
ON ERROR GOTO 0
LOCATE 10,20: PRINT "FILE CREATED"
END IF
LOCATE 25,79
STOP

END SELECT

GOTO Start

DEF FnHEX2$ (N)
IF N < &H10 THEN FnHEX2$ = "0" + HEX$(N) ELSE FnHEX2$ = HEX$ (N)
END DEF
' __________________________________________________________

GetChoice:
DO
IF F = B OR (F = 8 AND B = 0) THEN INCR F
COLOR 15,0
CALL GetUserColorChoice (F,B)
COLOR F, B: LOCATE 16,20: PRINT F,B
IF F = B OR (F = 8 AND B = 0) THEN
LOCATE 11,10: COLOR 15,1: PLAY "O3 MS B16 G16"
PRINT " OOPS! Your combination,";F;"&";B;", is INVISIBLE. Try again ... "
ELSE
LOCATE 12,10: COLOR 0,0: PRINT SPACE$ (65)
END IF
LOOP WHILE F = B OR (F = 8 AND B = 0)
RETURN

SUB GetUserColorChoice(Fore%,Back%)
' (c) 1988 Barry Erick
' used by presumption -- thanks
FirstY% = 2 'MAX is 17 MIN is 2
FirstX% = 3 'MAX is 16 MIN is 1
' CLS
Fore% = Fore% MOD 17
back% = back% MOD 9
If Fore% <0 THEN Fore% = 0
If Back% < 0 THEN Back% = 0
FirstY% = FirstY% MOD 18
IF FirstY%<2 THEN FirstY%=2
FirstX% = FirstX% MOD 17
IF FirstX%<1 THEN FirstX%=1
Title$ = "Move with "+CHR$(24)+CHR$(25)+CHR$(26)+CHR$(27)+"; Selects"
Title$ = "BARRY'S COLOR CHART. " + Title$
LOCATE FirstY%-1,(32-(LEN(Title$)/2))
PRINT title$;
LOCATE FirstY%,FirstX%
FOR Y% = 0 TO 7
FOR X% = 0 TO 15
COLOR X%,Y%
PRINT " XX ";
NEXT
LOCATE CSRLIN+1,FirstX%
NEXT
UsersFirstX%=(Fore%*4)+FirstX%
usersFirstY%=Back%+FirstY%
LOCATE UsersFirstY%,UsersFirstX%
Cline% = CSRLIN
Ps%=POS
Oldcline%=Cline%
Oldps%=Ps%
COLOR ((Ps%\4)-(FirstX%\4))+16,Cline%-FirstY%
PRINT " XX ";

DO
WHILE NOT INSTAT:WEND
A$=INKEY$
IF LEN(A$)=1 THEN
SELECT CASE A$
CASE CHR$(13)
' this one
Fore%=(Oldps%\4)-(FirstX%\4)
Back%=Oldcline%-FirstY%
IF FirstY%>13 THEN
LOCATE 2,1
ELSE
LOCATE FirstY%+9,1
END IF
EXIT LOOP
END SELECT
ELSEIF LEN(A$)=2 THEN
SELECT CASE ASC(RIGHT$(A$,1))
CASE 72 'up arrow
IF CSRLIN >FirstY% THEN
DECR Cline%
END IF
CASE 75 'left arrow
IF POS >FirstX%+4 THEN
DECR Ps%,4
END IF
CASE 77 'right arrow
IF POS INCR Ps%,4
END IF
CASE 80 ' down arrow
IF CSRLIN < FirstY%+7 THEN
INCR Cline%
END IF
END SELECT
END IF
LOCATE Oldcline%,Oldps%
COLOR ((Oldps%\4)-(FirstX%\4)),Oldcline% -FirstY%
PRINT " XX ";
COLOR ((Ps%\4)-(FirstX%\4))+16,Cline%-FirstY%
Oldcline% = Cline%
Oldps%=Ps%
LOCATE Cline%,Ps%
PRINT " XX ";
LOOP

END SUB

Oops:
LOCATE 8,1: PRINT "ERROR OPENING FILE ";BatName$
PLAY "O0 C4": DO: LOOP UNTIL INKEY$ <> ""
RESUME Start