a simple Palette Builder

[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.

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