## Simple color picker

minimy
Enthusiast
Posts: 270
Joined: Mon Jul 08, 2013 8:43 pm

### Simple color picker

Just it, a simple color picker in a window.

Code: Select all

``````

Procedure mkPaleta(ww.i,hh.i)
Protected.d w,h,d
Protected.a p,yy
w=ww/32
h=hh/8
img= CreateImage(#PB_Any,ww,hh)
StartDrawing(ImageOutput(img))
;rojo
yy=0
For p=0 To 15
Box(p*w,h*yy,w+1,h+1, RGB(p*16,0,0))
Next p
For p=0 To 15
Box((p+16)*w,h*yy,w+1,h+1, RGB(255,p*16,p*16))
Next p
;naranja
yy=1
For p=0 To 15
Box(p*w,h*yy,w+1,h+1, RGB(p*16,(p*16)/2,0))
Next p
For p=0 To 15
Box((p+16)*w,h*yy,w+1,h+1, RGB(255,127+((p*16)/2),(p*16)/2))
Next p
;amarillo
yy=2
For p=0 To 15
Box(p*w,h*yy,w+1,h+1, RGB(p*16,p*16,0))
Next p
For p=0 To 15
Box((p+16)*w,h*yy,w+1,h+1, RGB(255,255,p*16))
Next p
;verde
yy=3
For p=0 To 15
Box(p*w,h*yy,w+1,h+1, RGB(0,p*16,0))
Next p
For p=0 To 15
Box((p+16)*w,h*yy,w+1,h+1, RGB(p*16,255,p*16))
Next p
;celeste
yy=4
For p=0 To 15
Box(p*w,h*yy,w+1,h+1, RGB(0,(p*16)/2,p*16))
Next p
For p=0 To 15
Box((p+16)*w,h*yy,w+1,h+1, RGB((p*16)/2,127+((p*16)/2),255) )
Next p
;azul
yy=5
For p=0 To 15
Box(p*w,h*yy,w+1,h+1, RGB(0,0,p*16))
Next p
For p=0 To 15
Box((p+16)*w,h*yy,w+1,h+1, RGB(p*16,p*16,255))
Next p
;lila
yy=6
For p=0 To 15
Box(p*w,h*yy,w+1,h+1, RGB(p*16,0,p*16))
Next p
For p=0 To 15
Box((p+16)*w,h*yy,w+1,h+1, RGB(255,p*16,255))
Next p
;gris
yy=7
For p=0 To 15
Box(p*w,h*yy,w+1,h+1, RGB(p*8,p*8,p*8))
Next p
For p=0 To 15
Box((p+16)*w,h*yy,w+1,h+1, RGB(127+p*8,127+p*8,127+p*8))
Next p

StopDrawing()
ProcedureReturn img
EndProcedure

CompilerIf #PB_Compiler_IsMainFile

If OpenWindow(0, 0, 0, 500, 300, "Colors", #PB_Window_BorderLess | #PB_Window_ScreenCentered)
SetWindowColor(0,0)
imgcolors= mkPaleta(WindowWidth(0)-4,WindowHeight(0)-34)
TextGadget(1,2,WindowHeight(0)-34,WindowWidth(0)-4,30,"LMB select color - RMB exit",#PB_Text_Center|#SS_CENTERIMAGE)
Repeat
Event = WaitWindowEvent()

Select Event

Case 0
If EventType()= #PB_EventType_RightClick
Break
EndIf
If EventType()= #PB_EventType_LeftClick
StartDrawing(ImageOutput(imgcolors))
x= DesktopMouseX()-WindowX(0)-2
y= DesktopMouseY()-WindowY(0)-2
If x>=0 And x<ImageWidth(imgcolors) And y>=0 And y<ImageHeight(imgcolors)
newcolor= Point(x,y)
EndIf
StopDrawing()
EndIf
EndSelect

EndSelect
Until Event = #PB_Event_CloseWindow
EndIf

CompilerEndIf

``````
If translation=Error: reply="Sorry, Im Spanish": Endif
Kwai chang caine
Posts: 4915
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

### Re: Simple color picker

Funny selector
Works nice here, thanks for sharing
Not a destination
minimy
Enthusiast
Posts: 270
Joined: Mon Jul 08, 2013 8:43 pm

### Re: Simple color picker

Hi Kwai chang caine, is old school palette from 80´s haha
If translation=Error: reply="Sorry, Im Spanish": Endif
MiLoo
User
Posts: 47
Joined: Fri Jan 28, 2011 12:26 pm

### Re: Simple color picker

ColorPicker_HSL 取色板

Code: Select all

``````;***********************************
;迷路仟整理 2019.02.11
;ColorPicker_HSL取色板
;***********************************

Enumeration
#winScreen
#cvsSpectrum
#lblCurColor
#lblColorR
#lblColorG
#lblColorB
#txtCurColor
#txtColorR
#txtColorG
#txtColorB

#imgSpectrum
EndEnumeration

Structure __MainInfo
Spectrum.l
Index.l
CurColor.l
X.l
Y.l
IsDown.b
EndStructure

Global _Main.__MainInfo

_Main\Spectrum = \$0000FF
_Main\CurColor = \$0000FF
_Main\x = 255+10
_Main\y = 0+10
_Main\Index = 10

Procedure Create_Spectrum()
If StartDrawing(ImageOutput(#imgSpectrum))
Box(000, 000, 025, 256, _Main\Spectrum)
BackColor (\$FFFFFFFF)
FrontColor(\$00FFFFFF)
Box(0, 0, 025, 128)
BackColor (\$00000000)
FrontColor(\$FF000000)
Box(0, 129, 025, 128)
StopDrawing()
EndIf
EndProcedure

Procedure Redraw_Spectrum(Pos)
If StartDrawing(CanvasOutput(#cvsSpectrum))
Box(0, 0, 045, 276, \$F0F0F0)
DrawImage(ImageID(#imgSpectrum), 10, 10)
If Pos >= 10 And Pos <= 255+10
_Main\CurColor = Point(30, Pos)
_Main\Index = Pos
EndIf
DrawingMode(#PB_2DDrawing_Outlined)
Box (10-1, 10-1, 25+2, 256+2, \$808080)

LineXY(10-2, _Main\Index-0, 10-6, _Main\Index-4, \$000000)
LineXY(10-2, _Main\Index-0, 10-6, _Main\Index+4, \$000000)
LineXY(10-8, _Main\Index-4, 10-6, _Main\Index-4, \$000000)
LineXY(10-8, _Main\Index+4, 10-6, _Main\Index+4, \$000000)
LineXY(10-9, _Main\Index-3, 10-9, _Main\Index+3, \$000000)

LineXY(34+2, _Main\Index-0, 34+6, _Main\Index-4, \$000000)
LineXY(34+2, _Main\Index-0, 34+6, _Main\Index+4, \$000000)
LineXY(34+8, _Main\Index-4, 34+6, _Main\Index-4, \$000000)
LineXY(34+8, _Main\Index+4, 34+6, _Main\Index+4, \$000000)
LineXY(34+9, _Main\Index-3, 34+9, _Main\Index+3, \$000000)
StopDrawing()
EndIf
EndProcedure

Procedure Event_cvsSpectrum()
Select EventType()
Case #PB_EventType_LeftButtonDown
_Main\IsDown = #True
If Y >= 10 And Y<=255+10
Redraw_Spectrum(Y)
EndIf
Case #PB_EventType_LeftButtonUp
_Main\IsDown = #False
Case #PB_EventType_MouseMove
If _Main\IsDown = #True
If Y >= 10 And Y<=255+10
Redraw_Spectrum(Y)
EndIf
EndIf
EndSelect
EndProcedure

Box(000, 000, 256, 256, \$F0F0F0)
For B = 0 To 255 Step 6
Line(X, 0, 1, 256, RGB(255, 000, B)) : X+1
Next
For R = 255 To 0 Step -6
Line(X, 0, 1, 256, RGB(R, 000, 255)) : X+1
Next
For G = 0 To 255 Step 6
Line(X, 0, 1, 256, RGB(000, G, 255)) : X+1
Next
For B = 255 To 0 Step -6
Line(X, 0, 1, 256, RGB(000, 255, B)) : X+1
Next
For R = 0 To 255 Step 6
Line(X, 0, 1, 256, RGB(R, 255, 000)) : X+1
Next
For G = 255 To 0 Step -6
Line(X, 0, 1, 256, RGB(255, G, 000)) : X+1
Next

;上下透明度渐变
BackColor (\$00000000)
FrontColor(\$FF808080)
Box(0, 0, 256, 256)
StopDrawing()
EndIf
EndProcedure

Box(000, 000, 400, 400, \$F0F0F0)
;取色点
DrawingMode(#PB_2DDrawing_Outlined)
If _Main\x >= 10 And  _Main\x <= 255+10  And _Main\y >= 10 And _Main\y <= 255+10
Circle(_Main\x, _Main\y, 08, \$FFFFFF)
Circle(_Main\x, _Main\y, 09, \$000000)
_Main\Spectrum = Point(_Main\x, _Main\y)
EndIf
StopDrawing()
Create_Spectrum()
Redraw_Spectrum(_Main\Index)
EndIf
EndProcedure

Select EventType()
Case #PB_EventType_LeftButtonDown
If X >= 10 And X <= 255+10 : _Main\X = X : EndIf
If Y >= 10 And Y <= 255+10 : _Main\Y = Y : EndIf
_Main\IsDown = #True
Case #PB_EventType_LeftButtonUp
_Main\IsDown = #False

Case #PB_EventType_MouseMove
If _Main\IsDown = #True
If X >= 10 And X <= 255+10 : _Main\X = X : EndIf
If Y >= 10 And Y <= 255+10 : _Main\Y = Y : EndIf
EndIf
EndSelect
EndProcedure

CreateImage(#imgSpectrum, 025, 256)
Create_Spectrum()

hWindow = OpenWindow(#winScreen, 0, 0, 500, 286, "ColorPicker_HSL取色板", WindowFlags)
CanvasGadget(#cvsSpectrum, 290, 005, 045, 276, #PB_Canvas_ClipMouse)
TextGadget  (#lblCurColor, 350, 010, 080, 030, "", #PB_Text_Border)
StringGadget(#txtCurColor, 350, 050, 080, 020, "0x000000")

TextGadget  (#lblColorR, 350, 085, 020, 020, "R:")
StringGadget(#txtColorR, 370, 080, 060, 020, "0")
TextGadget  (#lblColorG, 350, 110, 020, 020, "G:")
StringGadget(#txtColorG, 370, 105, 060, 020, "0")
TextGadget  (#lblColorB, 350, 135, 020, 020, "B:")
StringGadget(#txtColorB, 370, 130, 060, 020, "0")

Redraw_Spectrum(0)

Repeat
WinEvent  = WindowEvent()
Select WinEvent
Case #PB_Event_CloseWindow : IsExitWindow = #True
EndSelect
Delay(1)
Until IsExitWindow = #True
End``````
I came to the ancient oriental country - China
I will PureBasic called B++
MiLoo
User
Posts: 47
Joined: Fri Jan 28, 2011 12:26 pm

### Re: Simple color picker

ColorPicker_HSV 取色板

Code: Select all

``````;***********************************
;迷路仟整理 2019.02.11
;ColorPicker_HSV取色板
;***********************************

Enumeration
#winScreen
#cvsSpectrum
#lblCurColor
#lblColorR
#lblColorG
#lblColorB
#txtCurColor
#txtColorR
#txtColorG
#txtColorB

#imgSpectrum
EndEnumeration

Structure __MainInfo
Spectrum.l
Index.l
CurColor.l
X.l
Y.l
IsDown.b
EndStructure

Global _Main.__MainInfo

_Main\Spectrum = \$0000FF
_Main\CurColor = \$0000FF
_Main\x = 255+10
_Main\y = 0+10
_Main\Index = 10

Box(000, 000, 256, 256, \$F0F0F0)
;左右红色渐变
BackColor(\$FFFFFF)
FrontColor(_Main\Spectrum)
Box(0, 0, 256, 256)

;上下透明度渐变
BackColor (\$00000000)
FrontColor(\$FF000000)
Box(0, 0, 256, 256)
StopDrawing()
EndIf
EndProcedure

Box(000, 000, 400, 400, \$F0F0F0)
;取色点
DrawingMode(#PB_2DDrawing_Outlined)
If _Main\x >= 10 And  _Main\x <= 255+10  And _Main\y >= 10 And _Main\y <= 255+10
Circle(_Main\x, _Main\y, 08, \$FFFFFF)
Circle(_Main\x, _Main\y, 09, \$000000)
_Main\CurColor = Point(_Main\x, _Main\y)
EndIf
StopDrawing()
EndIf
EndProcedure

Select EventType()
Case #PB_EventType_LeftButtonDown
If X >= 10 And X <= 255+10 : _Main\X = X : EndIf
If Y >= 10 And Y <= 255+10 : _Main\Y = Y : EndIf
_Main\IsDown = #True
Case #PB_EventType_LeftButtonUp
_Main\IsDown = #False

Case #PB_EventType_MouseMove
If _Main\IsDown = #True
If X >= 10 And X <= 255+10 : _Main\X = X : EndIf
If Y >= 10 And Y <= 255+10 : _Main\Y = Y : EndIf
EndIf
EndSelect
EndProcedure

Procedure Create_Spectrum()
If StartDrawing(ImageOutput(#imgSpectrum))
Box(000, 000, 025, 256, \$FFFFFF)
For B = 0 To 255 Step 6
Line(0, Y, 025, 1, RGB(255, 000, B)) : Y+1
Next
For R = 255 To 0 Step -6
Line(0, Y, 025, 1, RGB(R, 000, 255)) : Y+1
Next
For G = 0 To 255 Step 6
Line(0, Y, 025, 1, RGB(000, G, 255)) : Y+1
Next
For B = 255 To 0 Step -6
Line(0, Y, 025, 1, RGB(000, 255, B)) : Y+1
Next
For R = 0 To 255 Step 6
Line(0, Y, 025, 1, RGB(R, 255, 000)) : Y+1
Next
For G = 255 To 0 Step -6
Line(0, Y, 025, 1, RGB(255, G, 000)) : Y+1
Next
StopDrawing()
EndIf
EndProcedure

Procedure Redraw_Spectrum(Pos)
If StartDrawing(CanvasOutput(#cvsSpectrum))
Box(0, 0, 045, 276, \$F0F0F0)
DrawImage(ImageID(#imgSpectrum), 10, 10)
If Pos >= 10 And Pos <= 255+10
_Main\Spectrum = Point(30, Pos)
_Main\Index = Pos
EndIf
DrawingMode(#PB_2DDrawing_Outlined)
Box (10-1, 10-1, 25+2, 256+2, \$808080)

LineXY(10-2, _Main\Index-0, 10-6, _Main\Index-4, \$000000)
LineXY(10-2, _Main\Index-0, 10-6, _Main\Index+4, \$000000)
LineXY(10-8, _Main\Index-4, 10-6, _Main\Index-4, \$000000)
LineXY(10-8, _Main\Index+4, 10-6, _Main\Index+4, \$000000)
LineXY(10-9, _Main\Index-3, 10-9, _Main\Index+3, \$000000)

LineXY(34+2, _Main\Index-0, 34+6, _Main\Index-4, \$000000)
LineXY(34+2, _Main\Index-0, 34+6, _Main\Index+4, \$000000)
LineXY(34+8, _Main\Index-4, 34+6, _Main\Index-4, \$000000)
LineXY(34+8, _Main\Index+4, 34+6, _Main\Index+4, \$000000)
LineXY(34+9, _Main\Index-3, 34+9, _Main\Index+3, \$000000)

StopDrawing()
EndIf
EndProcedure

Procedure Event_cvsSpectrum()
Select EventType()
Case #PB_EventType_LeftButtonDown
_Main\IsDown = #True
If Y >= 10 And Y<=255+10
Redraw_Spectrum(Y)
EndIf
Case #PB_EventType_LeftButtonUp
_Main\IsDown = #False
Case #PB_EventType_MouseMove
If _Main\IsDown = #True
If Y >= 10 And Y<=255+10
Redraw_Spectrum(Y)
EndIf
EndIf
EndSelect
EndProcedure

CreateImage(#imgSpectrum, 025, 256)
Create_Spectrum()

hWindow = OpenWindow(#winScreen, 0, 0, 500, 286, "ColorPicker_HSV取色板", WindowFlags)
CanvasGadget(#cvsSpectrum, 290, 005, 045, 276, #PB_Canvas_ClipMouse)
TextGadget  (#lblCurColor, 350, 010, 080, 030, "", #PB_Text_Border)
StringGadget(#txtCurColor, 350, 050, 080, 020, "0x000000")

TextGadget  (#lblColorR, 350, 085, 020, 020, "R:")
StringGadget(#txtColorR, 370, 080, 060, 020, "0")
TextGadget  (#lblColorG, 350, 110, 020, 020, "G:")
StringGadget(#txtColorG, 370, 105, 060, 020, "0")
TextGadget  (#lblColorB, 350, 135, 020, 020, "B:")
StringGadget(#txtColorB, 370, 130, 060, 020, "0")

Redraw_Spectrum(0)

Repeat
WinEvent  = WindowEvent()
Select WinEvent
Case #PB_Event_CloseWindow : IsExitWindow = #True
EndSelect
Delay(1)
Until IsExitWindow = #True
End

``````
I came to the ancient oriental country - China
I will PureBasic called B++
BarryG
Posts: 1511
Joined: Thu Apr 18, 2019 8:17 am

### Re: Simple color picker

Just to check: you know there's a ColorRequester() command, right? I can't tell if you don't know, or are just posting an alternative picker (because you didn't say).
MiLoo
User
Posts: 47
Joined: Fri Jan 28, 2011 12:26 pm

### Re: Simple color picker

BarryG wrote: Wed May 05, 2021 1:29 pm Just to check: you know there's a ColorRequester() command, right? I can't tell if you don't know, or are just posting an alternative picker (because you didn't say).
A new ColorRequester solution that mimics PhotoShop
I came to the ancient oriental country - China
I will PureBasic called B++
KayBur
User
Posts: 17
Joined: Tue Apr 20, 2021 11:45 am

### Re: Simple color picker

MiLoo wrote: Wed May 05, 2021 8:27 pm
BarryG wrote: Wed May 05, 2021 1:29 pm Just to check: you know there's a ColorRequester() command, right? I can't tell if you don't know, or are just posting an alternative picker (because you didn't say).
A new ColorRequester solution that mimics PhotoShop
Why come up with a second Photoshop? One already exists. There is also Corel Drow, which allows you to work with vector format. As for me, these advanced tools are enough.
PureBasic Expert
Posts: 3997
Joined: Sun Apr 12, 2009 6:27 am

### Re: Simple color picker

Hi Gentlemen
We shouldn't discuss the post but the bugs if there is
I remember I saw a similar one to Milo by StarGate
Thanks minimy and MiLoo
Have fun
Egypt my love
minimy
Enthusiast
Posts: 270
Joined: Mon Jul 08, 2013 8:43 pm

### Re: Simple color picker

Hello, wow this is not simple color picker
Hey!! Really good job pbmaniacs!!
I was looking for old palettes like cbm Amiga or atari ST (16 or 32 colors), no real gradients with a lot of colors. What is an amiga or atari st??
I try to no use colorrequester because stop the program waiting for response. I know, no stop threads, but when no use, stop all.

Thanks for comments and improves!! be happy!
If translation=Error: reply="Sorry, Im Spanish": Endif
BarryG
Posts: 1511
Joined: Thu Apr 18, 2019 8:17 am

### Re: Simple color picker

minimy wrote: Sun May 09, 2021 10:42 pmI try to no use colorrequester because stop the program waiting for response

Code: Select all

``````Global colorpicked,colorpickeropen

Procedure ColorRequesterAsync(color=0)
colorpickeropen=1
colorpicked=ColorRequester(color)
colorpickeropen=0
EndProcedure

Repeat
Debug Second(Date())
Delay(250)
Until colorpickeropen=0
``````
Gene Abney
New User
Posts: 1
Joined: Mon May 10, 2021 12:06 pm

### Re: Simple color picker

Thanks for this great tool.