+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Utilities (https://staging.qb64phoenix.com/forumdisplay.php?fid=8)
+---- Thread: 256 color CMYK and Printstring variants (/showthread.php?tid=610)
256 color CMYK and Printstring variants - James D Jarvis - 07-13-2022
Really 2 utilities a CMYK palette builder for 256 color modes (easily adapted to other indexed modes)
and a number of print commands for default text using _PRINTSTRING but using text sized columns and rows for coordinates.
Code: (Select All)
' build a 256 color CMYK palette
' a variety of print subroutines using default text with coordinates as text row and column
Screen _NewImage(800, 500, 256)
Dim Shared klr
'build a CMYK palette
loadCMYK ' this routine builds a cmyk pallette
Color 20, 0
Cls
'demonstartion of text command within program
pat 1, 2, "Hello"
cpat 1, 4, "Color text", 0, 20
pato 1, 6, "Over text", "_"
cpato 1, 8, "Over Color Text", 0, 15, "-", 78
Vpat 2, 10, "Vertical"
CVpat 4, 10, "Color Vertical", 0, 10
CVpato 6, 10, "Over Color Vertical", 0, 15, "ð", 66
Vpato 8, 10, "Hello", 0, 10, "_"
boxtext 10, 10, "Box", "*", 1
cboxtext 20, 10, "Color BOX", "+", 2, 0, 100
cboxtexto 20, 20, "Color OVER BOX", "+", 2, 0, 100, "°", 18
fillboxt 50, 20, " Fill Box ", "+", 1, 0, 100, "°", 18, 8
Locate 25, 60
Input a$
Cls
fillboxt 1, 1, " Sample CMYK Palette", "*", 1, 0, 18, "°", 18, 8
Locate 4, 1
For klr = 0 To 255
Color 20, klr
If klr > 13 And klr < 21 Then Color 0, klr
Print " "; klr; " ";
Next
Color 20, 0
Sub pal_cmyk (pk, c, m, y, k)
' create a 256 color palette entry using CMYK
' CMYK process color Cyan, Magenta, Yellow, Black each expressed as a percent from 0 to 100
r = 255 * (100 - c)
r = (r / 100) * ((100 - k) / 100)
g = 255 * (100 - m)
g = (g / 100) * ((100 - k) / 100)
b = 255 * (100 - y)
b = (b / 100) * ((100 - k) / 100)
_PaletteColor pk, _RGB32(r, g, b)
End Sub
Sub pat (c, r, txt$)
'print txt$ at colooum c and row r
cc = (c - 1) * 8
rr = (r - 1) * 16
_PrintString (cc, rr), txt$
End Sub
Sub cpat (c, r, txt$, fk, bk)
obk = _BackgroundColor
ofk = _DefaultColor
Color fk, bk
cc = (c - 1) * 8
rr = (r - 1) * 16
_PrintString (cc, rr), txt$
Color ofk, obk
End Sub
Sub Vpat (c, r, txt$)
'Vertical print at
cc = (c - 1) * 8
rr = (r - 1) * 16
n = Len(txt$)
For p = 1 To n
r2 = rr + ((p - 1) * 16)
_PrintString (cc, r2), Mid$(txt$, p, 1)
Next
End Sub
Sub CVpat (c, r, txt$, fk, bk)
'Vertical print at
obk = _BackgroundColor
ofk = _DefaultColor
Color fk, bk
cc = (c - 1) * 8
rr = (r - 1) * 16
n = Len(txt$)
For p = 1 To n
r2 = rr + ((p - 1) * 16)
_PrintString (cc, r2), Mid$(txt$, p, 1)
Next
Color ofk, obk
End Sub
Sub pato (c, r, txt$, ch$)
'print txt$ at colooum c and row r of charcter ch$
' this saves and restores the program default printomode so the user does not have to redefine it"
pm = _PrintMode
cc = (c - 1) * 8
rr = (r - 1) * 16
ll = Len(txt$)
_PrintMode _FillBackground
For c2 = cc To (cc + (ll - 1) * 8)
_PrintString (c2, rr), ch$
Next c2
_PrintMode _KeepBackground
_PrintString (cc, rr), txt$
Select Case pm
Case 1
_PrintMode _KeepBackground
Case 2
_PrintMode _OnlyBackground
Case 3
_PrintMode _FillBackground
End Select
End Sub
Sub cpato (c, r, txt$, fk, bk, ch$, ck)
'princt colored text over character ch$ which is in color ck
pm = _PrintMode
obk = _BackgroundColor
ofk = _DefaultColor
cc = (c - 1) * 8
rr = (r - 1) * 16
ll = Len(txt$)
Color ck, bk
_PrintMode _FillBackground
For c2 = cc To (cc + (ll - 1) * 8)
_PrintString (c2, rr), ch$
Next c2
_PrintMode _KeepBackground
Color fk, bk
_PrintString (cc, rr), txt$
Select Case pm
Case 1
_PrintMode _KeepBackground
Case 2
_PrintMode _OnlyBackground
Case 3
_PrintMode _FillBackground
End Select
Color ofk, obk
End Sub
Sub CVpato (c, r, txt$, fk, bk, ch$, ck)
'Vertical print at
pm = _PrintMode
obk = _BackgroundColor
ofk = _DefaultColor
Color ck, bk
_PrintMode _FillBackground
cc = (c - 1) * 8
rr = (r - 1) * 16
n = Len(txt$)
For p = 1 To n
r2 = rr + ((p - 1) * 16)
_PrintString (cc, r2), ch$
Next
_PrintMode _KeepBackground
Color fk, bk
For p = 1 To n
r2 = rr + ((p - 1) * 16)
_PrintString (cc, r2), Mid$(txt$, p, 1)
Next
Select Case pm
Case 1
_PrintMode _KeepBackground
Case 2
_PrintMode _OnlyBackground
Case 3
_PrintMode _FillBackground
End Select
Color ofk, obk
End Sub
Sub Vpato (c, r, txt$, fk, bk, ch$)
'Vertical print at
pm = _PrintMode
_PrintMode _FillBackground
cc = (c - 1) * 8
rr = (r - 1) * 16
n = Len(txt$)
For p = 1 To n
r2 = rr + ((p - 1) * 16)
_PrintString (cc, r2), ch$
Next
_PrintMode _KeepBackground
For p = 1 To n
r2 = rr + ((p - 1) * 16)
_PrintString (cc, r2), Mid$(txt$, p, 1)
Next
Select Case pm
Case 1
_PrintMode _KeepBackground
Case 2
_PrintMode _OnlyBackground
Case 3
_PrintMode _FillBackground
End Select
End Sub
Sub boxtext (c, r, txt$, b$, bb)
'printboxed text at column,row, b$ is hte border character,bb is the border buffer in character size
n = Len(txt$)
bw = n + (bb * 2)
bh = 1 + (bb * 2)
rr = (r - 1) * 16
For cc = c To c + bw
_PrintString ((cc - 1) * 8, rr), b$
_PrintString ((cc - 1) * 8, rr + (bh - 1) * 16), b$
Next
c1 = (c - 1) * 8
c2 = (c + bw) * 8
For rr = r To (r + bh - 1)
_PrintString (c1, (rr - 1) * 16), b$
_PrintString (c2, (rr - 1) * 16), b$
Next rr
cc = (c + bb) * 8
rr = (r + bb - 1) * 16
_PrintString (cc, rr), txt$
End Sub
Sub cboxtext (c, r, txt$, b$, bb, fk, bk)
'printboxed text at column,row, b$ is hte border character,bb is the border buffer in character size
obk = _BackgroundColor
ofk = _DefaultColor
Color fk, bk
n = Len(txt$)
bw = n + (bb * 2)
bh = 1 + (bb * 2)
For cc = c To c + bw
For rr = r To (r + bh - 1)
_PrintString ((cc - 1) * 8, (rr - 1) * 16), " "
Next
Next
rr = (r - 1) * 16
For cc = c To c + bw
_PrintString ((cc - 1) * 8, rr), b$
_PrintString ((cc - 1) * 8, rr + (bh - 1) * 16), b$
Next
c1 = (c - 1) * 8
c2 = (c + bw) * 8
For rr = r To (r + bh - 1)
_PrintString (c1, (rr - 1) * 16), b$
_PrintString (c2, (rr - 1) * 16), b$
Next rr
cc = (c + bb) * 8
rr = (r + bb - 1) * 16
_PrintString (cc, rr), txt$
Color ofk, obk
End Sub
Sub cboxtexto (c, r, txt$, b$, bb, fk, bk, o$, ock)
'printboxed text at column,row, b$ is hte border character,bb is the border buffer in character size
obk = _BackgroundColor
ofk = _DefaultColor
pm = _PrintMode
_PrintMode _FillBackground
n = Len(txt$)
bw = n + (bb * 2)
bh = 1 + (bb * 2)
Color ock, bk
For cc = c To c + bw
For rr = r To (r + bh - 1)
_PrintString ((cc - 1) * 8, (rr - 1) * 16), o$
Next
Next
Color fk, bk
rr = (r - 1) * 16
For cc = c To c + bw
_PrintString ((cc - 1) * 8, rr), b$
_PrintString ((cc - 1) * 8, rr + (bh - 1) * 16), b$
Next
c1 = (c - 1) * 8
c2 = (c + bw) * 8
For rr = r To (r + bh - 1)
_PrintString (c1, (rr - 1) * 16), b$
_PrintString (c2, (rr - 1) * 16), b$
Next rr
cc = (c + bb) * 8
rr = (r + bb - 1) * 16
_PrintMode _KeepBackground
_PrintString (cc, rr), txt$
Color ofk, obk
Select Case pm
Case 1
_PrintMode _KeepBackground
Case 2
_PrintMode _OnlyBackground
Case 3
_PrintMode _FillBackground
End Select
End Sub
Sub fillboxt (c, r, txt$, b$, bb, fk, bk, o$, ock, rate)
'box text with a marque fill style that runs once
obk = _BackgroundColor
ofk = _DefaultColor
pm = _PrintMode
n = Len(txt$)
bw = n + (bb * 2)
bh = 1 + (bb * 2)
For x = 1 To n
_Limit rate
_PrintMode _FillBackground
Color ock, bk
For cc = c To c + bw
For rr = r To (r + bh - 1)
_PrintString ((cc - 1) * 8, (rr - 1) * 16), o$
Next
Next
Color fk, bk
rr = (r - 1) * 16
For cc = c To c + bw
_PrintString ((cc - 1) * 8, rr), b$
_PrintString ((cc - 1) * 8, rr + (bh - 1) * 16), b$
Next
c1 = (c - 1) * 8
c2 = (c + bw) * 8
For rr = r To (r + bh - 1)
_PrintString (c1, (rr - 1) * 16), b$
_PrintString (c2, (rr - 1) * 16), b$
Next rr
cc = (c + bb) * 8 + (n - x) * 8
rr = (r + bb - 1) * 16
_PrintMode _KeepBackground
_PrintString (cc, rr), Mid$(txt$, 1, x)
Next x
Color ofk, obk
Select Case pm
Case 1
_PrintMode _KeepBackground
Case 2
_PrintMode _OnlyBackground
Case 3
_PrintMode _FillBackground
End Select
End Sub
Sub loadCMYK
'builing a cmyk palete
'this paletteuses set of colors in 20 incremental
klr = 0
c = 0
m = 0
y = 0
k = 0
For klr = 0 To 255
Select Case klr
Case 1 TO 20 'lightest grey to black in 5% increments
k = k + 5
c = 0
m = 0
y = 0
Case 21 TO 40 'cyan on white in 5% increments
k = 0
c = c + 5
m = 0
y = 0
Case 41 TO 60 'magenta on white in 5% increments
k = 0
c = 0
m = m + 5
y = 0
Case 61 TO 80 'yellow on white in 5% increments
k = 0
c = 0
m = 0
y = y + 5
Case 81 TO 100 'cyan and magenta on white in 5% increments
k = 0
c = c + 5
m = m + 5
y = 0
Case 101 TO 120 'cyan and yellow on white in 5% increments
k = 0
c = c + 5
m = 0
y = y + 5
Case 121 TO 140 'magenta and yellow on white in 5% increments
k = 0
c = 0
m = m + 5
y = y + 5
Case 121 TO 140 'cyan and magenta in 5% increments with 20% black
k = 20
c = c + 5
m = m + 5
y = 0
Case 141 TO 160 'cyan and yellow in 5% increments with 20% black
k = 20
c = c + 5
m = 0
y = y + 5
Case 161 TO 180 'magenta and yellow in 5% increments with 20% black
k = 20
c = 0
m = m + 5
y = y + 5
Case 181 TO 200
k = 40
c = c + 5
m = m + 5
y = 0
Case 201 TO 220
k = 40
c = c + 5
m = 0
y = y + 5
Case 221 TO 240
k = 40
c = 0
m = m + 5
y = y + 5
Case 241 TO 255
k = 10 + (klr - 240) * 4
c = 0
m = 100
y = y + 5
End Select
pal_cmyk klr, c, m, y, k
Color 0, klr
Print " "; klr; " ";
Next klr
End Sub