Page 1 of 1

Color selection

Posted: Wed Feb 01, 2023 8:55 pm
by AZJIO
Here is my color selection example

Image

Code: Select all

EnableExplicit

;- Перечисления
Enumeration Window
	#Window
EndEnumeration

Enumeration Gadget
	#Slider1
	#Slider2
	#Slider3
	#Spectr
	#Hue
	#Satur
	#Bright
	#Label1
	#Label2
	#Label3
	#Color
	#EditColor
	#btnSel
	#btnOK
EndEnumeration

Declare Events()
Declare rgb_to_hsb()
Declare hsb_to_rgb()
Declare Slider_Chande_Color()
Declare Set_Slider_Color_RGB()()

Define w, h, i

Global Dim arr_rgb(2)
Global Dim arr_hsb(2)

;- Lang
Global lang0$
Global Dim aLng.s(12)
aLng(0) = "Tone"
aLng(1) = "Saturation"
aLng(2) = "Brightness"
aLng(3) = "select"

; Поддержка русского языка
!var v_lang0$ = navigator.language;
If lang0$ = "ru-RU"
	aLng(0) = "Тон"
	aLng(1) = "Насыщенность"
	aLng(2) = "Яркость"
	aLng(3) = "выбрать"
EndIf

;- GUI
If OpenWindow(#Window, 0, 0, 440, 170, "", #PB_Window_BorderLess | #PB_Window_ScreenCentered)
	
	TrackBarGadget(#Slider1, 0, 20, 282, 25, 0, 360)
	TrackBarGadget(#Slider2, 0, 50, 282, 25, 0, 100)
	TrackBarGadget(#Slider3, 0, 80, 282, 25, 0, 100)
	CanvasGadget(#Spectr, 12, 4, 260, 7, #PB_Canvas_Transparent)
	TextGadget(#Hue, 283, 20, 30, 20, "")
	TextGadget(#Satur, 283, 50, 30, 20, "")
	TextGadget(#Bright, 283, 80, 30, 20, "")
	TextGadget(#Label1, 317, 20, 113, 20, aLng(0))
	TextGadget(#Label2, 317, 50, 113, 20, aLng(1))
	TextGadget(#Label3, 317, 80, 85, 20, aLng(2))
	TextGadget(#Color , 0, 110, 60, 60, "")
	StringGadget(#EditColor , 85, 110 , 70 , 28 , "FF0000")
	ButtonGadget(#btnSel, 85, 139, 70, 28, aLng(3))
	ButtonGadget(#btnOK, 180, 110, 96, 38, "OK")
	
	BindGadgetEvent(#Slider1, @Events())
	BindGadgetEvent(#Slider2, @Events())
	BindGadgetEvent(#Slider3, @Events())
	BindGadgetEvent(#btnOK, @Events())
	BindGadgetEvent(#btnSel, @Set_Slider_Color_RGB())
	
	
	; Спектр
	If StartDrawing(CanvasOutput(#Spectr))
		w=OutputWidth()
		h=OutputHeight()
		arr_hsb(1) = 100
		arr_hsb(2) = 100
		
		For i=0 To w
			arr_hsb(0)=i*360/w
			hsb_to_rgb()
			Line(i, 1, 1, h, RGB(arr_rgb(0), arr_rgb(1), arr_rgb(2)))
		Next
		
		StopDrawing()
	EndIf
	
	Set_Slider_Color_RGB()
EndIf


Procedure Events()
	Protected i
	Select Event()
		Case #PB_Event_Gadget
			Select EventGadget()
					
				Case #Slider1
					arr_hsb(0) = GetGadgetState(#Slider1)
					Slider_Chande_Color()
					SetGadgetText(#Hue, Str(arr_hsb(0)))
					
				Case #Slider2
					arr_hsb(1) = GetGadgetState(#Slider2)
					Slider_Chande_Color()
					SetGadgetText(#Satur, Str(arr_hsb(1)))
				Case #Slider3
					arr_hsb(2) = GetGadgetState(#Slider3)
					Slider_Chande_Color()
					SetGadgetText(#Bright, Str(arr_hsb(2)))
					
				Case #btnOK
					MessageRequester(RSet(Hex(RGB(arr_rgb(2), arr_rgb(1), arr_rgb(0))), 6, "0"))
			EndSelect
	EndSelect
EndProcedure



; Procedure hsb_to_rgb(arr_hsb)
Procedure hsb_to_rgb()
	Protected sector
	Protected.f ff, pp, qq, tt
	Protected.f Dim af_rgb(2) ; создаём массивы в которых числа будут в диапазоне 0-1
	Protected.f Dim af_hsb(2)
	; Protected Dim arr_rgb(2)
	
	af_hsb(2) = arr_hsb(2) /100
	
	If arr_hsb(1) = 0 ; если серый, то одно значение всем
		arr_rgb(0)=Round(af_hsb(2)*255, #PB_Round_Nearest)
		arr_rgb(1)=arr_rgb(0)
		arr_rgb(2)=arr_rgb(0)
		; ProcedureReturn arr_rgb
	EndIf
	
	While arr_hsb(0)>=360 ; если тон задан большим запредельным числом, то
		arr_hsb(0)-360
	Wend
	
	af_hsb(1) = arr_hsb(1) / 100
	af_hsb(0) = arr_hsb(0) / 60
	; sector = Int(arr_hsb(0))
	sector = Round(af_hsb(0), #PB_Round_Down)
	
	ff=af_hsb(0) - sector
	pp=af_hsb(2)*(1-af_hsb(1))
	qq=af_hsb(2)*(1-af_hsb(1)*ff)
	tt=af_hsb(2)*(1-af_hsb(1)*(1-ff))
	
	Select sector
		Case 0
			af_rgb(0)=af_hsb(2)
			af_rgb(1)=tt
			af_rgb(2)=pp
		Case 1
			af_rgb(0)=qq
			af_rgb(1)=af_hsb(2)
			af_rgb(2)=pp
		Case 2
			af_rgb(0)=pp
			af_rgb(1)=af_hsb(2)
			af_rgb(2)=tt
		Case 3
			af_rgb(0)=pp
			af_rgb(1)=qq
			af_rgb(2)=af_hsb(2)
		Case 4
			af_rgb(0)=tt
			af_rgb(1)=pp
			af_rgb(2)=af_hsb(2)
		Default
			af_rgb(0)=af_hsb(2)
			af_rgb(1)=pp
			af_rgb(2)=qq
	EndSelect
	
	; RGB
	arr_rgb(0)=Round(af_rgb(0)*255, #PB_Round_Nearest)
	arr_rgb(1)=Round(af_rgb(1)*255, #PB_Round_Nearest)
	arr_rgb(2)=Round(af_rgb(2)*255, #PB_Round_Nearest)
	
	; BGR
	; arr_rgb(2)=Round(af_rgb(0)*255, #PB_Round_Nearest)
	; arr_rgb(1)=Round(af_rgb(1)*255, #PB_Round_Nearest)
	; arr_rgb(0)=Round(af_rgb(2)*255, #PB_Round_Nearest)
	
	; ProcedureReturn arr_rgb
EndProcedure


Procedure rgb_to_hsb()
	Protected.f min, max
	
	If arr_rgb(0)<=arr_rgb(1)
		min=arr_rgb(0)
		max=arr_rgb(1)
	Else
		min=arr_rgb(1)
		max=arr_rgb(0)
	EndIf
	
	If min>arr_rgb(2)
		min=arr_rgb(2)
	EndIf
	
	If max<arr_rgb(2)
		max=arr_rgb(2)
	EndIf
	
	If max = min
		arr_hsb(0)=0
	ElseIf max = arr_rgb(0)
		arr_hsb(0)=60*(arr_rgb(1)-arr_rgb(2))/(max - min)
		If arr_rgb(1)<arr_rgb(2)
			arr_hsb(0)+360
		EndIf
	ElseIf max = arr_rgb(1)
		arr_hsb(0)=60*(arr_rgb(2)-arr_rgb(0))/(max - min)+120
	ElseIf max = arr_rgb(2)
		arr_hsb(0)=60*(arr_rgb(0)-arr_rgb(1))/(max - min)+240
	EndIf
	
	If max = 0
		arr_hsb(1)=0
	Else
		arr_hsb(1)=(1-min/max)*100
	EndIf
	
	arr_hsb(2)=max/255*100
	
	arr_hsb(0)=Round(arr_hsb(0), #PB_Round_Nearest)
	arr_hsb(1)=Round(arr_hsb(1), #PB_Round_Nearest)
	arr_hsb(2)=Round(arr_hsb(2), #PB_Round_Nearest)
	
	; ProcedureReturn arr_hsb
EndProcedure


Procedure Slider_Chande_Color()
	Protected rgb_color
	arr_hsb(0) = GetGadgetState(#Slider1)
	arr_hsb(1) = GetGadgetState(#Slider2)
	arr_hsb(2) = GetGadgetState(#Slider3)
	hsb_to_rgb()
	rgb_color = RGB(arr_rgb(0), arr_rgb(1), arr_rgb(2))
	SetGadgetColor(#Color, #PB_Gadget_BackColor, rgb_color)
	SetGadgetText(#EditColor , RSet(Hex(RGB(arr_rgb(2), arr_rgb(1), arr_rgb(0))), 6, "0"))
EndProcedure


Procedure Set_Slider_Color_RGB()
	Protected RBG, rgb_color
	RBG = Val("$" + GetGadgetText(#EditColor))
	arr_rgb(2) = Red(RBG)
	arr_rgb(1) = Green(RBG)
	arr_rgb(0) = Blue(RBG)
	rgb_to_hsb()
	SetGadgetState(#Slider1 , arr_hsb(0))
	SetGadgetState(#Slider2 , arr_hsb(1))
	SetGadgetState(#Slider3 , arr_hsb(2))

	SetGadgetText(#Hue, Str(arr_hsb(0)))
	SetGadgetText(#Satur, Str(arr_hsb(1)))
	SetGadgetText(#Bright, Str(arr_hsb(2)))

	rgb_color = RGB(arr_rgb(0), arr_rgb(1), arr_rgb(2))
	SetGadgetColor(#Color, #PB_Gadget_BackColor, rgb_color)
EndProcedure

Re: Color selection

Posted: Thu Feb 02, 2023 10:16 am
by bembulak
Thanks for sharing. Interesting example!