ColorPicker is an easy to use FUNCTION that asks for and returns a selected color. I put this together for a future drawing program. When you call the function, a color box pops on the screen. Use the mouse to select a color and click CLOSE. The color value is returned. If you press ESC you can cancel the color box. When the color box closes the original background is preserved.
- Dav
- Dav
Code: (Select All)
'================
'COLORPICKER2.BAS
'================
'Simple to use color picker function.
'Coded by Dav for QB64-PE, AUG/2023
'Use mouse, hover over a color to choose, then
'Click left mouse button to select that color.
'You will see the color appear in the box, along
'with a gradient strip of color variations also.
'If you are happy with your color selection, then
'Press CLOSE to exit picker and return selected color.
'Press ESC to cancel making a selection.
Screen _NewImage(1000, 600, 32)
_FullScreen
Paint (0, 0), _RGB(33, 66, 99)
'=== draw stuff
For x = 25 To _Width - 25 Step 10
For y = 25 To _Height - 25 Step 10
Line (x, y)-Step(5, 5), _RGB(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
Next
_Delay .5
x = (_Width / 2) - 233: y = (_Height / 2) - 123
clr& = ColorPicker&(x, y)
_Delay .5
'clr& is the returned value
If clr& <> 0 Then
'=== break clr& into RGB valued
red = _Red32(clr&): grn = _Green32(clr&): blu = _Blue32(clr&)
'=== draw something to show color picked
Line (50, 50)-(150, 150), _RGB(red, grn, blu), BF
'=== Print color values to user
Print "Selected color: "; clr&; ", or _RGB ("; red; ","; grn; ","; blu; ")"
Else
Print "No color selected"
End If
End
'======================================
Function ColorPicker& (xpos, ypos)
'Update ColorPicker& Function by Dav, AUG/2023.
'Function Returns color picked by user if one selected.
'If no color selected before Closing, function returns 0
'Click CLOSE to close the ColorPicker image.
'ESC key also cancels selection and closes picker box.
'The xpos/ypos is x/y point on the screen to place colorpicker
'=== Save users display status
DisplayStatus% = _AutoDisplay
'=== copy current screen using _MEM (thanks Steve!)
'=== Used this method because_COPYIMAGE(_DISPLAY) didnt always work
Dim scr1 As _MEM, scr2 As _MEM
scr1 = _MemImage(0): scr2 = _MemNew(scr1.SIZE)
_MemCopy scr1, scr1.OFFSET, scr1.SIZE To scr2, scr2.OFFSET
'=== Save current PRINT colors too, restore later
fgclr& = _DefaultColor: bgclr& = _BackgroundColor
'=== Create Colorpicker menu box
Line (xpos, ypos)-(xpos + 463, ypos + 243), _RGB(0, 0, 0), BF
Line (xpos + 2, ypos + 2)-(xpos + 463 - 2, ypos + 243 - 2), _RGB(255, 255, 255), BF
'=== make custom palette array of 16 basic soft colors to use
ReDim pal&(0 To 15)
pal&(0) = _RGB(255, 50, 50) 'red
pal&(1) = _RGB(255, 155, 52) 'orange
pal&(2) = _RGB(255, 255, 0) 'yellow
pal&(3) = _RGB(52, 2207, 52) 'green
pal&(4) = _RGB(52, 105, 255) 'blue
pal&(5) = _RGB(0, 255, 255) 'teal
pal&(6) = _RGB(105, 105, 207) 'violet
pal&(7) = _RGB(100, 0, 153) 'purple
pal&(8) = _RGB(255, 192, 203) 'pink
pal&(9) = _RGB(204, 204, 204) 'silver
pal&(10) = _RGB(255, 207, 52) 'gold
pal&(11) = _RGB(204, 204, 153) 'beige
pal&(12) = _RGB(155, 75, 0) 'brown
pal&(13) = _RGB(128, 128, 128) 'gray
pal&(14) = _RGB(0, 0, 0) 'black
pal&(15) = _RGB(255, 255, 255) 'white
'=== draw color blocks
For x = xpos + 10 To xpos + 200 Step 56
For y = ypos + 10 To ypos + 200 Step 56
Line (x, y)-Step(56, 56), pal&(p), BF: p = p + 1
Line (x, y)-(x + 56, y + 56), _RGB(128, 128, 128), B
Next
Next
'=== draw color selection areas
Line ((xpos + 246), (ypos + 10))-((xpos + 453), (ypos + 70)), _RGB(128, 128, 128), B
Color _RGB(128, 128, 128), _RGB(255, 255, 255)
_PrintString (xpos + 246, ypos + 10), " New Color: "
Line ((xpos + 246), (ypos + 77))-((xpos + 454), (ypos + 135)), _RGB(128, 128, 128), B
_PrintString (xpos + 246, ypos + 77), " Gradient: "
'=== draw CLOSE button area
w& = _RGB(255, 255, 255): r& = _RGB(255, 0, 0)
Line (xpos + 246, ypos + 158)-(xpos + 453, ypos + 229), r&, BF
bx = xpos + 250: by = ypos + 158
Line (bx + 17, by + 11)-Step(29, 49), w&, BF 'C
Line (bx + 29, by + 20)-Step(6, 31), r&, BF
Line (bx + 35, by + 31)-Step(11, 10), r&, BF
Line (bx + 57, by + 11)-Step(12, 49), w&, BF 'L
Line (bx + 57, by + 50)-Step(20, 10), w&, BF
Line (bx + 87, by + 11)-Step(28, 49), w&, BF 'O
Line (bx + 98, by + 23)-Step(6, 27), r&, BF
Line (bx + 125, by + 11)-Step(26, 49), w&, BF 'S
Line (bx + 135, by + 20)-Step(5, 11), r&, BF
Line (bx + 135, by + 27)-Step(16, 4), r&, BF
Line (bx + 125, by + 39)-Step(16, 4), r&, BF
Line (bx + 136, by + 39)-Step(5, 11), r&, BF
Line (bx + 161, by + 11)-Step(21, 49), w&, BF 'E
Line (bx + 173, by + 21)-Step(9, 10), r&, BF
Line (bx + 173, by + 39)-Step(9, 11), r&, BF
'====================================
'=== Now get users color selection...
'=== no selection made yet
selected = 0
'=== main loop
Do
'=== Get mouse input
While _MouseInput
'=== Get mouse x/y
mx = _MouseX: my = _MouseY
'=== Only poll this area
If mx > xpos And mx < (xpos + 473) And my > ypos And my < (ypos + 243) Then
'=== if click button in area
If _MouseButton(1) Then
'=== if clicked in CLOSE box area
If mx > (xpos + 246) And mx < (xpos + 453) And my > (ypos + 158) And my < (ypos + 229) Then
Exit Do
End If
'=== made a color selection
selected = 1
'=== Get color where mouse pointer is
clr& = Point(mx, my)
'=== Make Red Green Blue color values
red = _Red32(clr&): grn = _Green32(clr&): blu = _Blue32(clr&)
'=== show color selected in box
Line ((xpos + 246), (ypos + 10))-((xpos + 453), (ypos + 70)), _RGB(red, grn, blu), BF
Line ((xpos + 246), (ypos + 10))-((xpos + 453), (ypos + 70)), _RGB(128, 128, 128), B
'=== Update gradient strip with color...
'=== ...ONLY if mouse is not in gradient strip area
If mx <= (xpos + 246) Or mx >= (xpos + 455) Or my <= (ypos + 78) Or my >= (ypos + 136) Then
'draw from color to whiteout
c = 0
xpc = (453 - 246 / 2)
For x = (xpos + xpc) To (xpos + 246) Step -4
Line (x, (ypos + 77))-(x + 4, (ypos + 135)), _RGB(red + c, grn + c, blu + c), BF
c = c + 8
Next
'now draw from color to blackout
c = 0
For x2 = xpos + xpc To xpc + xpos + 120 Step 4
Line (x2, (ypos + 77))-(x2 + 4, (ypos + 135)), _RGB(red + c, grn + c, blu + c), BF
c = c - 8
Next
Line ((xpos + 246), (ypos + 77))-((xpos + 454), (ypos + 135)), _RGB(128, 128, 128), B
End If
End If
'=== update screen, not used for now
'_DISPLAY
End If
Wend
'=== ESC key cancels picking and closes
If InKey$ = Chr$(27) Then
selected = 0: Exit Do
End If
Loop 'UNTIL INKEY$ <> ""
'=== wait for mouse button UP to continue
Do: mi = _MouseInput: Loop Until _MouseButton(1) = 0
'=== if user selected color, say so
If selected = 1 Then
ColorPicker& = clr&
Else
ColorPicker& = 0
End If
'====================================
'=== Restore background screen as it was
_MemCopy scr2, scr2.OFFSET, scr2.SIZE To scr1, scr1.OFFSET
_MemFree scr1: _MemFree scr2
'=== Restore display status as it was
If DisplayStatus% = -1 Then _AutoDisplay
'=== restore PRINT colors
Color fgclr&, bgclr&
End Function