02-01-2023, 04:42 PM
(This post was last modified: 02-01-2023, 05:51 PM by James D Jarvis.)
Needed a palette editor for another 256 color mode program screen so I wrote this program. This makes use of dialog commands, the mouse, and simple keyboard commands. Loads and save the palette files as a simple data file. Also saves out the palette as lines of basic code.
EDIT: added commands to copy and paste individual colors cells.
EDIT: added commands to copy and paste individual colors cells.
Code: (Select All)
'Palette_Builder
'by James D. Jarvis , Feb 2/1/2023
'
'a simple 256 color palette builder for QB64 PE
' saves and loads simple palette data files or basic source code to build a palette
Dim klr(0 To 255) As _Unsigned Long
Dim tklr As _Unsigned Long
Screen _NewImage(1100, 400, 256)
_Title "Palette_Builder"
Dim Shared showpalnos
showpalnos = 0
klr(0) = _RGB32(0, 0, 0)
klr(1) = _RGB32(0, 0, 255)
klr(2) = _RGB32(0, 128, 0)
klr(3) = _RGB32(0, 217, 217)
klr(4) = _RGB32(255, 0, 0)
klr(5) = _RGB32(193, 0, 193)
klr(6) = _RGB32(149, 5, 5)
klr(7) = _RGB32(192, 192, 192)
klr(8) = _RGB32(100, 100, 100)
klr(9) = _RGB32(0, 128, 255)
klr(10) = _RGB32(128, 255, 128)
klr(11) = _RGB32(128, 255, 255)
klr(12) = _RGB32(255, 128, 0)
klr(13) = _RGB32(255, 128, 255)
klr(14) = _RGB32(255, 255, 128)
klr(15) = _RGB32(250, 250, 250)
klr(255) = _RGB32(250, 250, 250)
For k = 16 To 254
klr(k) = _RGB32(k, Int(k * .8), Int(k * .4))
Next k
klr(101) = _RGB32(100, 100, 100)
For k = 16 To 255
_PaletteColor k, klr(k)
Next k
Color 255, 0
drawgrid
Do
_Limit 500
kk$ = InKey$
Mouser mx, my, mb
If mb = -1 And lb = 0 Then 'open color dialog on left button mouse click over grid position for color
If mx > -1 And mx < 1024 And my > -1 And my < 256 Then
px = mx \ 32
py = my \ 32
pk = py * 32 + px
Line (10, 310)-(800, 340), klr(0), BF
pm$ = "Color #: " + Str$(pk) + " R,G,B: " + Str$(_Red32(klr(pk))) + "," + Str$(_Green32(klr(pk))) + "," + Str$(_Blue32(klr(pk)))
_PrintString (10, 312), pm$
End If
End If
If mb = 0 And lb = -2 Then 'open color dialog on right button mouse release over grid position for color
If mx > -1 And mx < 1024 And my > -1 And my < 256 Then
px = mx \ 32
py = my \ 32
pk = py * 32 + px
If pk > -1 And pk < 256 Then
klr(pk) = _ColorChooserDialog("Choose Color", _RGB32(_Red32(klr(pk)), _Green32(klr(pk)), _Blue32(klr(pk))))
_PaletteColor pk, klr(pk)
End If
End If
End If
lb = mb 'record mouse button just clicked as last button clicked
Select Case kk$
Case "s", "S" 'save palette
savefile$ = _SaveFileDialog$("Save File", "", "*.*", "")
If savefile$ <> "" Then
_MessageBox "Information", "File will be saved to " + savefile$
Open savefile$ For Output As #1
For k = 0 To 255
Print #1, klr(k)
Next k
Close #1
End If
Case "l", "L" 'load palette
loadfile$ = _OpenFileDialog$("Open File", "", "*.*", "*.*", -1)
If loadfile$ <> "" Then
_MessageBox "Information", "You selected " + loadfile$
k = 0
Open loadfile$ For Input As #1
Do Until EOF(1)
Input #1, klr(k)
_PaletteColor k, klr(k)
k = k + 1
Loop
Close #1
drawgrid
End If
Case "b", "B" 'save basic code for palette to a file
savefile$ = _SaveFileDialog$("Save Basic Code to File", "", "*.*", "")
If savefile$ <> "" Then
_MessageBox "Information", "File will be saved to " + savefile$
Open savefile$ For Output As #1
Print #1, "'256 color palette uncomment lines as needed for use"
Print #1, "'Screen _NewImage(600, 400,256) "
Print #1, "'dim shared klr(0 to 255) as _unsigned long"
For k = 0 To 255
bc$ = ""
bc$ = "klr(" + _Trim$(Str$(k)) + ") = _rgb32(" + _Trim$(Str$(_Red32(klr(k)))) + "," + _Trim$(Str$(_Green32(klr(k)))) + "," + _Trim$(Str$(_Blue32(klr(k)))) + ")"
Print #1, bc$
Next k
Print #1, "'For k = 0 To 255 "
Print #1, "' _PaletteColor k, klr(k) "
Print #1, "' Next k"
Close #1
End If
Case "n", "N" 'toggle display of color numbers on palette grid
If showpalnos = 0 Then showpalnos = 1 Else showpalnos = 0
drawgrid
Case "c", "C"
Mouser mx, my, mb
If mx > -1 And mx < 1024 And my > -1 And my < 256 Then
px = mx \ 32
py = my \ 32
pk = py * 32 + px
Line (10, 310)-(800, 340), klr(0), BF
pm$ = "Color #: " + Str$(pk) + " R,G,B: " + Str$(_Red32(klr(pk))) + "," + Str$(_Green32(klr(pk))) + "," + Str$(_Blue32(klr(pk)))
_PrintString (10, 312), pm$
If pk > 0 And pk < 256 Then tklr = klr(pk)
End If
Case "p", "P"
Mouser mx, my, mb
If mx > -1 And mx < 1024 And my > -1 And my < 256 Then
px = mx \ 32
py = my \ 32
pk = py * 32 + px
If pk > 0 And pk < 256 Then klr(pk) = tklr
_PaletteColor pk, klr(pk)
End If
End Select
Loop Until kk$ = Chr$(27)
System
'draw the palette grid
Sub drawgrid
_PrintMode _KeepBackground
For y = 0 To 7
For x = 0 To 31
yy = y * 32
xx = x * 16
dk = yy + x
xx = xx * 2
Line (xx, yy)-(xx + 30, yy + 30), dk, BF
If showpalnos = 1 Then
_PrintString (xx + 2, yy + 6), _Trim$(Str$(dk))
End If
Next x, y
_PrintString (10, 257), "S - Save File L - Load File B - Save Basic Code N - show color #'s <ESC> -QUIT "
_PrintString (10, 275), "Left Click - show RGB values Right Click - change RGB values "
_PrintString (10, 293), "C - Copy color P - Paste color"
End Sub
'mouse sub from wiki with added check for mouse(2)
Sub Mouser (x, y, b)
mi = _MouseInput
b = _MouseButton(1)
If _MouseButton(2) = -1 Then b = -2
x = _MouseX
y = _MouseY
End Sub