Below is an updated/expanded version, which also adds a Function that returns the variable name for the specified number. This code could easily be modified to create some other numbered variables list (something other than colors) by changing the DATA statement, the DIM, and the numbers in the FOR loops.
The file it creates looks like this:
Code: (Select All)
'' MakColS2.bas -- Make Color Sub 2
'' by Abazek, 2025mar02
''
'' Creates a text file containing QBasic/QB64/QB64PE code to create shared
'' variables for the standard SCREEN 0 text colors. Also includes a Function
'' that returns the color name for a given number.
''
'' Resulting code contains:
'' 1. The SUB and FUNCTION (put these at end of your code with other SUBs and
'' FUNCTIONS)
'' 2. The DIM Shared (put towards start of code with other DIMs/CONSTs/TYPEs),
'' 3. The DECLARE SUB (which is only needed for QBasic and QuickBasic. Needs
'' to be at the start of your code. QB64 and QB64PE don't require this).
''
'' DATA statement below contains the color variable names I normally use.
'' You can change them to your liking.
''
DATA blk,blu,grn,cyn,red,pur,brn,lgr,dgr,lblu,lgrn,lcyn,lred,lpur,lyel,wht
DIM ColNam(0 TO 15) AS STRING
DIM q, a$
a$ = "DIM SHARED "
'' Read in Data. Add color name and comma-space to above Dim Shared.
FOR q = 0 TO 15
READ ColNam(q)
a$ = a$ + ColNam(q) + ", "
NEXT q
'' remove the last comma-space
a$ = LEFT$(a$, LEN(a$) - 2)
'' write it out
OPEN "ColorSub.bas" FOR OUTPUT AS #1
PRINT #1, "DECLARE FUNCTION getTextColor$ (q!)"
PRINT #1, "DECLARE SUB initTextColors ()"
PRINT #1,
PRINT #1, a$
PRINT #1,
PRINT #1, "SUB initTextColors"
FOR q = 0 TO 15
a$ = " " + ColNam(q) + " =" + STR$(q)
PRINT #1, a$
NEXT q
PRINT #1, "END SUB"
PRINT #1,
PRINT #1, "FUNCTION getTextColor$ (q)"
PRINT #1, " DIM x$"
PRINT #1, " SELECT CASE q"
FOR q = 0 TO 15
a$ = " " + "CASE " + ColNam(q)
PRINT #1, a$
a$ = " " + "x$ = " + CHR$(34) + ColNam(q) + CHR$(34)
PRINT #1, a$
NEXT q
PRINT #1, " CASE ELSE"
PRINT #1, " x$ = " + CHR$(34) + "???" + CHR$(34)
PRINT #1, " END SELECT"
PRINT #1, " getTextColor$ = x$"
PRINT #1, "END FUNCTION"
CLOSE #1
PRINT
PRINT "A new COLORSUB.BAS file has been created."
PRINT
END
The file it creates looks like this:
Code: (Select All)
DECLARE FUNCTION getTextColor$ (q!)
DECLARE SUB initTextColors ()
DIM SHARED blk, blu, grn, cyn, red, pur, brn, lgr, dgr, lblu, lgrn, lcyn, lred, lpur, lyel, wht
SUB initTextColors
blk = 0
blu = 1
grn = 2
cyn = 3
red = 4
pur = 5
brn = 6
lgr = 7
dgr = 8
lblu = 9
lgrn = 10
lcyn = 11
lred = 12
lpur = 13
lyel = 14
wht = 15
END SUB
FUNCTION getTextColor$ (q)
DIM x$
SELECT CASE q
CASE blk
x$ = "blk"
CASE blu
x$ = "blu"
CASE grn
x$ = "grn"
CASE cyn
x$ = "cyn"
CASE red
x$ = "red"
CASE pur
x$ = "pur"
CASE brn
x$ = "brn"
CASE lgr
x$ = "lgr"
CASE dgr
x$ = "dgr"
CASE lblu
x$ = "lblu"
CASE lgrn
x$ = "lgrn"
CASE lcyn
x$ = "lcyn"
CASE lred
x$ = "lred"
CASE lpur
x$ = "lpur"
CASE lyel
x$ = "lyel"
CASE wht
x$ = "wht"
CASE ELSE
x$ = "???"
END SELECT
getTextColor$ = x$
END FUNCTION