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
