ColorPicker ColorWheel

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
SiggeSvahn
User
User
Posts: 40
Joined: Wed Oct 06, 2010 9:37 pm

ColorPicker ColorWheel

Post by SiggeSvahn »

Couldn't resist to start working on another ColorPicker. This time in some likeness of the Mac OS. Have fun, use and improve at your will!

Code: Select all

; This is a dummy caller to the ColorPicker2023. Please open both files and then Run this dummy caller.

EnableExplicit

#txt1=1 ; Beware of not useing the same ID-numbers as the gadgets in Colopicker.
#txt2=2

Define Wev, EventWindow, EvGadget, eTyp

OpenWindow(0, 0, 0, 300, 200, "ColorPickerCaller", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TextGadget(#txt1, 125,  50, 50, 50, "", #PB_Text_Border | 256) ; 256 är nödvändig för att kunna känna click.
SetGadgetColor(#txt1,#PB_Gadget_BackColor,#Red)
TextGadget(#txt2, 125,  120, 50, 50, "", #PB_Text_Border | 256) ; 256 är nödvändig för att kunna känna click.
SetGadgetColor(#txt2,#PB_Gadget_BackColor,#Green)

XIncludeFile "Colorpicker2023.pb" ; This file will be inserted.

Define udvColor1.udtColorHSLrgba
Define udvColor2.udtColorHSLrgba

udvColor1\H = 0 ; HueAngle Zero means #Red. Theses values would normally be saved/retrieved from an ini-file.
udvColor1\S = 100 ; %
udvColor1\L = 100 ; %

udvColor2\H = 120 ; HueAngle 120 means #Green. Theses values would normally be saved/retrieved from an ini-file.
udvColor2\S = 100 ; %
udvColor2\L = 100 ; %

Repeat
Wev = WaitWindowEvent() ; Testar för systemhändelser.
EventWindow = EventWindow()
EvGadget=EventGadget()
eTyp = EventType()

If Wev = #PB_Event_Gadget               ; If user clicks or drags on the gadgets of ColorPickerWindow...
  Select EvGadget
    Case #cgtColorCanvas
      MouseOnColorPickerWin(EvGadget, eTyp)   ; Gosub Colorpicker.
    Case #strRed To #chbAlpha                 ; StringGadgets ion ColorpickerWindow.
      If eTyp = #PB_EventType_Change
        MouseOnColorPickerWin(EvGadget, eTyp) ; Gosub Colorpicker.
      EndIf
    Case #txt1
      ColorCallingGadget = #txt1
      udvGlobalTempColor = udvColor1 ; udvGlobalTempColor is only used in ColorPickerWindow as an internal messenger.
      CreateCPWin()    
    Case #txt2
      ColorCallingGadget = #txt2
      udvGlobalTempColor = udvColor2
      CreateCPWin()
  EndSelect
EndIf
        
Until Wev = #PB_Event_CloseWindow
      
Last edited by SiggeSvahn on Sat Jan 11, 2020 11:53 pm, edited 1 time in total.
Newbie
SiggeSvahn
User
User
Posts: 40
Joined: Wed Oct 06, 2010 9:37 pm

Re: ColoPicker ColorWheel

Post by SiggeSvahn »

And here is the very ColorPicker:

Code: Select all

 ;This file is intended to use as XIncludeFile. Therefore all of its resources is initialised here.
EnableExplicit
;Metrics
#WinColpic_W265 = 265
#WinColpic_H265 = 265
#Margin25 = 25

#SaturationSliderX = 2

#CircleDiameter215=215
#AlphaSliderX = #Margin25  + 50
#AlphaSliderY = #WinColpic_H265 - 20
#AlphaSliderW = #CircleDiameter215 - 80

#LumaSliderX = #WinColpic_W265 - 22
#LumaSliderY = 25
#LumaSliderH = #WinColpic_H265 - 75

#IMAGE_HueCirkel=0
;#IMAGE_Text=1

Enumeration GADGETS
  #cgtColorCanvas=3
  #strRed
  #strGreen
  #strBlue
  #strHex
  #strSaturation
  #strAlpha
  #strLuma
  #chbAlpha
EndEnumeration

#Grey =  200 + 200*256 + 200*65536
#GreyRGBA = #Grey | 255 << 24 ; 255 innebär helt opaque.
#WhiteRGBA = #White | 255 << 24 ; 255 innebär helt opaque.

;FLAGS
#ZoneCircle =           1
#ZoneSaturationSlider = 2
#ZoneAlphaSlider =      3
#ZoneLumaSlider =       4
#UpdateCPgadgets =      5
#DontSplitRGB =         6
#DontSplitRGB_But_UpdateCPgadgets=7
#ValueIsPercent =       8
#JustWantRGBfromHSL =   9

Structure udtColorHSLrgba
  RGB.l ; 
  RGBA.l
  sHexColor.s
  R.l ; 255
  G.l ; 255
  B.l ; 255
  A.l ; 255
  H.l ; Hue 360 degrees.
  S.l ; Saturation %
  L.l ; Luminocity %
EndStructure

Define Event,x,y, XfromOrigo, YfromOrigo, HueDegrees, x
Global WinColorpicker, HueAngle.f, ActiveColorItem, udvGlobalTempColor.udtColorHSLrgba, ColorCallingGadget

Declare.l DrawSatSlider(y, Flag=0) ; To let the program call DrawSatSlider() from south & north.
Declare.l DrawLumaSlider(y, Flag=0) ; To let the program call DrawSatSlider() from south & north.


  Procedure ValuesToWinTitle(HueDegrees)
  ;Debug HueAngle
  SetWindowTitle(WinColorpicker, "Hue = " + Str(HueDegrees) + "; Sat = " + GetGadgetText(#strSaturation) + "; L = " + GetGadgetText(#strLuma) + "; A = " + GetGadgetText(#strAlpha))
  
  EndProcedure
  
  Procedure TextBoxLimiter(Gadget, Max)
    
    If Val(GetGadgetText(Gadget)) > Max 
      SetGadgetText(Gadget, Str(Max))
    EndIf

 EndProcedure 
 
 Procedure.l Hex2Dec(hex.s)
   Define r, d, a.s
   For r=1 To Len(hex.s)
        d<<4 : a.s=Mid(hex.s,r,1)
        If Asc(a.s)>60
            d+Asc(a.s)-55
        Else
            d+Asc(a.s)-48
        EndIf
    Next
  ProcedureReturn d
EndProcedure

  
 Procedure.l HSLToRGB(*udvColorByRef.udtColorHSLrgba, Flag); As Long
   ;HSLToRGB(LocalColorAngle.l, Saturation.l, Luminance.l, Flag); As Long
   Define R.l, G.l, B.l, lMax.l, lMid.l, lMin.l, q.f, LocalColorAngle
   ;Debug "HSLToRGB" + Str(*udvColorByRef\L) + "  Flag = " + Str(Flag)
   ;If    *udvColorByRef\L = 100 : Debug "DrawSliderLuma använder HSL för att skapa sliderns toppfärg." : EndIf
   
lMax = *udvColorByRef\L * 2.55 ;: Debug "*udvColorByRef\H " + Str(*udvColorByRef\H)
lMin = (255 - (*udvColorByRef\S * 2.55)) * lMax / 255 ; 255 - (Saturation * lMax / 255)
q = (lMax - lMin) / 255

LocalColorAngle = *udvColorByRef\H ;Hue degrees.
LocalColorAngle = LocalColorAngle * 4.25 ; Gör att 1530 motsvarar 360 grader.

Select LocalColorAngle
    Case 0 To 255
        lMid = (LocalColorAngle - 0) * q + lMin
        R = lMax: G = lMid: B = lMin
    Case 256 To 510 ;This period surpasses the node border with one unit - over to gren color. CHECK by F8.
        lMid = -(LocalColorAngle - 255) * q + lMax ;-(LocalColorAngle - 256) * q + lMin
        R = lMid: G = lMax: B = lMin
    Case 511 To 765
        lMid = (LocalColorAngle - 510) * q + lMin
        R = lMin: G = lMax: B = lMid
    Case 766 To 1020
        lMid = -(LocalColorAngle - 765) * q + lMax
        R = lMin: G = lMid: B = lMax
    Case 1021 To 1275
        lMid = (LocalColorAngle - 1020) * q + lMin
        R = lMid: G = lMin: B = lMax
    Case 1276 To 1530
        lMid = -(LocalColorAngle - 1275) * q + lMax
        R = lMax: G = lMin: B = lMid
    Default
        MessageRequester("Msg","Error occured in HSLToRGB. intSystemColorAngleMax1530= " + Str(LocalColorAngle))
EndSelect

  *udvColorByRef\RGB = RGB(R,G,B)
If flag <> #JustWantRGBfromHSL ; ============================================================
  *udvColorByRef\R = R 
  *udvColorByRef\G = G 
  *udvColorByRef\B = B 
  *udvColorByRef\RGBA = RGBA(R,G,B, *udvColorByRef\A)
  
; ============ HEXADECIMAL FORMATERING ============
If R < 16;&H10 
  ;txtHexColor = Right$("00000" & Hex$(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue), 6) ;Padding with zeroletters to the left.
  *udvColorByRef\sHexColor = Right("00000" + Hex(R * 65536 + G * 256 + B), 6)
Else
  ;txtHexColor = Hex$(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue)
  *udvColorByRef\sHexColor = Hex(R * 65536 + G * 256 + B)
EndIf
    
;---- OPTIONAL UPDATING GADGETS! -------------------
If Flag = #UpdateCPgadgets    
  SetGadgetText(#strRed,   Str(R))
  SetGadgetText(#strGreen, Str(G))
  SetGadgetText(#strBlue,  Str(B))
  SetGadgetText(#strHex, *udvColorByRef\sHexColor)
EndIf ; Angående Flag = #UpdateCPgadgets

DrawLumaSlider(*udvColorByRef\L, #ValueIsPercent) ; Uppdaterar kulören på slidern.
DrawSatSlider(*udvColorByRef\S, #ValueIsPercent) ; Uppdaterar kulören på slidern.

EndIf ; Angående flag <> #JustWantRGBfromHSL.

ProcedureReturn *udvColorByRef\RGB ; HSLToRGB = RGB(R,G,B) ; Delivers lngColor in RGB-format.

EndProcedure

Procedure RGBToHSL201(RGBValue.l, Flag);, RGBToHSL.HSL); As HSL
  Define R.l, G.l, B.l, lMax.l, lMin.l, lDiff.l, lSum.l, q.f;float.
  ;Debug "RGBToHSL201()"
;Define udtAngelSaturationBrightness.HSL
;Define RGBToHSL.HSL

If Flag = #DontSplitRGB Or Flag = #DontSplitRGB_But_UpdateCPgadgets; Already accurate values in udvGlobalTempColor.
  R = udvGlobalTempColor\R
  G = udvGlobalTempColor\G
  B = udvGlobalTempColor\B
Else
  R = Red(RGBValue)
  G = Green(RGBValue)
  B = Blue(RGBValue)
EndIf

If R > G
  lMax = R: lMin = G
Else
  lMax = G: lMin = R ;Finds the Superior and inferior components.
EndIf

If B > lMax 
  lMax = B
Else
  If B < lMin
    lMin = B
  EndIf
EndIf

lDiff = lMax - lMin
lSum = lMax + lMin
;Luminance, thus brightness; Adobe photoshop uses the logic that the site VBspeed.com has regarded as too primitive = superior decides the level of brightness.
udvGlobalTempColor\L = lMax / 255 * 100
;Saturation******
If lMax <> 0;Protecting from the impossible operation of division by zero.
    udvGlobalTempColor\S = 100 * lDiff / lMax ;The logic of Adobe Photoshops is this simple.
Else
    udvGlobalTempColor\S = 0
EndIf
;Hue ************** R is situated at the angel of 360 or zero degrees; G vid 120 degrees; B vid 240 degrees. intSystemColorAngleMax1530

If lDiff = 0
  q = 0
Else
  q = 60 / lDiff ;Protecting from the impossible operation of division by zero.
EndIf
Select lMax
    Case R
        If G < B 
            udvGlobalTempColor\H = 360 + q * (G - B)
            ;intSystemColorAngleMax1530 = (360 + q * (G - B)) * 4.25 ;Converting from degrees to my resolution of detail.
        Else
            udvGlobalTempColor\H = q * (G - B)
            ;intSystemColorAngleMax1530 = (q * (G - B)) * 4.25
        EndIf
    Case G
        udvGlobalTempColor\H = 120 + q * (B - R) ; (R - G)
        ;intSystemColorAngleMax1530 = (120 + q * (B - R)) * 4.25
    Case B
        udvGlobalTempColor\H = 240 + q * (R - G)
        ;intSystemColorAngleMax1530 = (240 + q * (R - G)) * 4.25
EndSelect ;The case of B was missing.

;---- OPTIONAL UPDATING GADGETS! -------------------
  If Flag = #UpdateCPgadgets Or Flag = #DontSplitRGB_But_UpdateCPgadgets 
    SetGadgetText(#strSaturation, Str(udvGlobalTempColor\S))
    SetGadgetText(#strLuma, Str(udvGlobalTempColor\L))
    udvGlobalTempColor\RGB  = RGB(R,G,B)
    udvGlobalTempColor\RGBA = RGBA(R,G,B, udvGlobalTempColor\A )
    SetGadgetText(#strRed,   Str(R)) : udvGlobalTempColor\R = R
    SetGadgetText(#strGreen, Str(G)) : udvGlobalTempColor\G = G
    SetGadgetText(#strBlue,  Str(B)) : udvGlobalTempColor\B = B
  
    ;txtHexColor = Hex$(R * 65536 + G * 256 + B): txtHexColor.Refresh ;Applying To internetstandard<>VBstandard
    If R < 16;&H10 
      ;txtHexColor = Right$("00000" & Hex$(R * 65536 + G * 256 + B), 6) ;Adds letters of zero to the left which is a necessary so called padding.
      udvGlobalTempColor\sHexColor = Right("00000" + Hex(R * 65536 + G * 256 + B), 6)
    Else
      ;txtHexColor = Hex$(R * 65536 + G * 256 + B)
      udvGlobalTempColor\sHexColor = Hex(R * 65536 + G * 256 + B)
    EndIf
    
    SetGadgetText(#strHex, udvGlobalTempColor\sHexColor)
    DrawSatSlider(udvGlobalTempColor\S, #ValueIsPercent)
    DrawLumaSlider(udvGlobalTempColor\L, #ValueIsPercent)
    
  EndIf
  
  
EndProcedure


  Procedure.l DrawSatSlider(y, Flag=0)
    Define Percent.f, Greyness, udvSat_SliderColor.udtColorHSLrgba
    
    If Flag = #ValueIsPercent
      y = #LumaSliderY +  #LumaSliderH - (#LumaSliderH * y / 100) ; Lumaslider has identical metrics to SaturationSlider.
    Else
      If y < #LumaSliderY 
        y = #LumaSliderY 
      ElseIf y > #LumaSliderY + #LumaSliderH 
        y = #LumaSliderY + #LumaSliderH 
      EndIf; SatirationSlider och LumaSlider har samma y-dimensioner.
    EndIf
    
    If StartDrawing( CanvasOutput(#cgtColorCanvas) )
      Box(#SaturationSliderX, #LumaSliderY, 20, #LumaSliderH, #White) ; Vit bakgrund.
      
      DrawingMode(#PB_2DDrawing_Gradient)
      udvSat_SliderColor   = udvGlobalTempColor ; udvGlobalTempColor is only used in ColorPickerWindow as an internal messenger.
      udvSat_SliderColor\S = 100                ; Max saturation.

      BackColor(HSLToRGB(@udvSat_SliderColor, #JustWantRGBfromHSL)) ; Gosub calculate RGB with max saturation.    
      Greyness = (255 * udvGlobalTempColor\L)/100
      FrontColor(RGB( Greyness,Greyness,Greyness))
      
      LinearGradient(#SaturationSliderX, #LumaSliderY, #SaturationSliderX + 20, #LumaSliderY + #LumaSliderH)
      Box(#SaturationSliderX, #LumaSliderY, 20, #LumaSliderH)
      
      DrawingMode(#PB_2DDrawing_Default)
      ;Box(x, #AlphaSliderY, #AlphaSliderW - (x - #AlphaSliderX),18,#White) ; Vitt fält som följer tracker.
      Box(#SaturationSliderX, y-3, 18, 5,#Red) ; Thumb aka tracker.
      StopDrawing()
    EndIf
    Percent = ((#LumaSliderY + #LumaSliderH - y) / #LumaSliderH) * 100
    
  ProcedureReturn  Percent; Ger noll vid minimum och 100% vid max.
  EndProcedure
  
 
  Procedure.l DrawLumaSlider(y, Flag=0)
   Define Percent.f, udvLumaSliderColor.udtColorHSLrgba
   ; Lumaslider has always gradient from maxLuma to Black.
   
   If Flag = #ValueIsPercent
     y = #LumaSliderY +  #LumaSliderH - (#LumaSliderH * y / 100)
   Else
     If y < #LumaSliderY 
       y = #LumaSliderY 
     ElseIf y > #LumaSliderY + #LumaSliderH 
       y = #LumaSliderY + #LumaSliderH 
     EndIf
   EndIf
   
    If StartDrawing( CanvasOutput(#cgtColorCanvas) )
      Box(#LumaSliderX, #LumaSliderY, 20, #LumaSliderH, #White) ; Vit bakgrund.
      
      DrawingMode(#PB_2DDrawing_Gradient)
;       BackColor(RGB($40,$40,$40))
;       FrontColor(RGB($DD,$DD,$DD))
      udvLumaSliderColor   = udvGlobalTempColor ; udvGlobalTempColor is only used in ColorPickerWindow as an internal messenger.
      udvLumaSliderColor\L = 100                ; Max Luma.
      ;HSLToRGB(@udvLumaSliderColor, #DontSplitRGB)
      BackColor(HSLToRGB(@udvLumaSliderColor, #JustWantRGBfromHSL)) ; Gosub calculate RGB with max Luma.
      FrontColor(#Black)
      
      LinearGradient(#LumaSliderX, #LumaSliderY, #LumaSliderX + 20, #LumaSliderY + #LumaSliderH)
      Box(#LumaSliderX, #LumaSliderY, 20, #LumaSliderH)
      
      DrawingMode(#PB_2DDrawing_Default)
      ;Box(x, #AlphaSliderY, #AlphaSliderW - (x - #AlphaSliderX),18,#White) ; Vitt fält som följer tracker.
      Box(#LumaSliderX, y-3, 18, 5,#Red) ; Thumb aka tracker.
      StopDrawing()
    EndIf
   Percent = ((#LumaSliderY + #LumaSliderH - y) / #LumaSliderH) * 100
    
  ProcedureReturn  Percent; Ger noll vid minimum och 100% vid max.
  EndProcedure
   
  Procedure DrawAlphaSlider(x)
Define Percent.f
    
    If x < #AlphaSliderX
      x = #AlphaSliderX 
    ElseIf x > #AlphaSliderX + #AlphaSliderW 
      x = #AlphaSliderX + #AlphaSliderW 
    EndIf
    
    If StartDrawing( CanvasOutput(#cgtColorCanvas) )
      Box(#AlphaSliderX, #AlphaSliderY, #AlphaSliderW, 18, #White) ; Vit bakgrund.
      
      DrawingMode(#PB_2DDrawing_Gradient)
      BackColor(RGB($40,$40,$40))
      FrontColor(RGB($DD,$DD,$DD))
      
      LinearGradient(#AlphaSliderX, #AlphaSliderY, #AlphaSliderX + #AlphaSliderW, #AlphaSliderY + 18)
      Box(#AlphaSliderX, #AlphaSliderY, #AlphaSliderW, 18)
      
      DrawingMode(#PB_2DDrawing_Default)
      ;Box(x, #AlphaSliderY, #AlphaSliderW - (x - #AlphaSliderX),18,#White) ; Vitt fält som följer tracker.
      Box(x-3, #AlphaSliderY, 5,18,#Red) ; Thumb aka tracker.
      StopDrawing()
    EndIf
    
    Percent = ((x - #AlphaSliderX) / #AlphaSliderW) * 100
    
  ProcedureReturn  Percent; Ger noll vid minimum och 100% vid max.
EndProcedure


Procedure.l CPzonedetector(x,y)
  Define Zone
  
   If x > #SaturationSliderX And x < #SaturationSliderX + 18 ; LumaSlider har samma mått som #SaturationSliderX.
    If y > #LumaSliderY And y < #LumaSliderY + #LumaSliderH
      ProcedureReturn #ZoneSaturationSlider
    EndIf
  EndIf
  
  If x > #Margin25 And x < #Margin25 + #CircleDiameter215
    If y > #Margin25 And y < #Margin25 + #CircleDiameter215
      ;Zone = #ZoneCircle
      ProcedureReturn #ZoneCircle
    EndIf
  EndIf
    
  If x > #AlphaSliderX And x < #AlphaSliderX + #AlphaSliderW
    If y > #AlphaSliderY And y < #AlphaSliderY + 18
      ;Zone = #ZoneAlphaSlider
      ProcedureReturn #ZoneAlphaSlider
    EndIf
  EndIf
  
  If x > #LumaSliderX And x < #LumaSliderX + 18
    If y > #LumaSliderY And y < #LumaSliderY + #LumaSliderH
      ProcedureReturn #ZoneLumaSlider
    EndIf
  EndIf
     
  ProcedureReturn 0 ; NoZone = Zero.
EndProcedure

Procedure.l MouseOnCanvasReaction(x,y)
   Define XfromOrigo, YfromOrigo, SliderPercent, Value
   Protected HueDegrees
   XfromOrigo = x - 132 ; 107
   YfromOrigo = 132 - y
   
  Select ActiveColorItem
    Case #ZoneCircle
      If XfromOrigo = 0 And YfromOrigo < 0 ; Skyddar från omöjlig nolldivision.
        HueAngle = 270
      ElseIf XfromOrigo = 0 And YfromOrigo > 0
        HueAngle = 90
      ElseIf XfromOrigo + YfromOrigo = 0
        HueAngle = 0
      Else
        HueAngle = Degree(ATan(YfromOrigo/XfromOrigo))
        If XfromOrigo>0 And YfromOrigo > 0: HueDegrees = HueAngle
        ElseIf XfromOrigo<0 And YfromOrigo > 0: HueDegrees = 180 + HueAngle
        ElseIf XfromOrigo<0 And YfromOrigo < 0: HueDegrees = 180 + HueAngle
        ElseIf XfromOrigo>0 And YfromOrigo < 0: HueDegrees = 360 + HueAngle
        EndIf
      EndIf
      udvGlobalTempColor\H = HueDegrees ; 0 - 360 degrees.
    Case #ZoneSaturationSlider
      SliderPercent = DrawSatSlider(y) ; procedurereturn value i %.
      SetGadgetText(#strSaturation, Str(SliderPercent))
      udvGlobalTempColor\S = SliderPercent ; * 2.55;? ; Windows uses 0-255 regarding Alpha so I'll do the same with the imaginary Saturation and Luma.
    Case #ZoneAlphaSlider
      SliderPercent = DrawAlphaSlider(x) ; procedurereturn value i %.
      SetGadgetText(#strAlpha, Str(SliderPercent))
      udvGlobalTempColor\A = SliderPercent ; * 2.55;?
    Case #ZoneLumaSlider
      SliderPercent = DrawLumaSlider(y) ; procedurereturn value i %.
      SetGadgetText(#strLuma, Str(SliderPercent))
      udvGlobalTempColor\L = SliderPercent ; * 2.55;?
  EndSelect ; ActiveColorItem CPzonedetector()  
  
  If ActiveColorItem <> #ZoneCircle : HueDegrees = udvGlobalTempColor\H : EndIf ; No change.
  HSLToRGB(@udvGlobalTempColor,#UpdateCPgadgets) ; ByRef för ibland vill vi använda fejkade värden.
  
  
  ProcedureReturn HueDegrees
  
EndProcedure

Procedure MouseOnColorPickerWin(EvGadget, eTyp)
  Define x, y, Value, FlagUserChanged_HSL, FlagUserChanged_RGBA
  Static HueDegrees, OldRGB
x = GetGadgetAttribute(#cgtColorCanvas, #PB_Canvas_MouseX)
y = GetGadgetAttribute(#cgtColorCanvas, #PB_Canvas_MouseY)

OldRGB = udvGlobalTempColor\RGB

Select EvGadget
  Case  #cgtColorCanvas
    If eTyp = #PB_EventType_LeftButtonDown
      ActiveColorItem = CPzonedetector(x,y) ; Only the first mousedown (not drag). Detect colorcircel or sliders and update the flag ActiveColorItem.
      If ActiveColorItem : HueDegrees = MouseOnCanvasReaction(x,y) : EndIf
    EndIf
    If eTyp = #PB_EventType_MouseMove And GetGadgetAttribute(#cgtColorCanvas, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
      HueDegrees = MouseOnCanvasReaction(x,y) : FlagUserChanged_HSL = 1 ; MouseOnCanvasReaction() handles also the sliders.
    EndIf
EndSelect
 
If eTyp = #PB_EventType_Change ; React if user changed content of txtboxes.
   Select EvGadget
     Case #strSaturation
       Value = Val(GetGadgetText(#strSaturation)) ; Converting percent to pixelpositions.
       Value = #LumaSliderY + #LumaSliderH - ((Value * #LumaSliderH) / 100) ; LumaSlider and SaturationSlider have identical dimensions.
       DrawSatSlider(Value)
       FlagUserChanged_HSL = 1
     Case #strAlpha
       Value = Val(GetGadgetText(#strAlpha)) ; Converting percent to pixelpositions.
       Value = ((Value * #AlphaSliderW) / 100) + #AlphaSliderX ; LumaSlider and SaturationSlider have identical dimensions.
       DrawAlphaSlider(Value)
     Case #strLuma
       Value = Val(GetGadgetText(#strLuma)) ; Converting percent to pixelpositions.
       Value = #LumaSliderY + #LumaSliderH - ((Value * #LumaSliderH) / 100) ; LumaSlider and SaturationSlider have identical dimensions.
       DrawLumaSlider(Value)
       FlagUserChanged_HSL = 1
     Case #chbAlpha
       If GetGadgetState(#chbAlpha)
         DisableGadget(#strAlpha,0)
       Else
         DisableGadget(#strAlpha,1)
       EndIf
     Case #strRed
       TextBoxLimiter(#strRed, 255)
       udvGlobalTempColor\R = Val(GetGadgetText(#strRed))
       RGBToHSL201(0,#DontSplitRGB_But_UpdateCPgadgets)
     Case #strGreen
       TextBoxLimiter(#strGreen, 255)
       udvGlobalTempColor\G = Val(GetGadgetText(#strGreen))
       RGBToHSL201(0,#DontSplitRGB_But_UpdateCPgadgets)
     Case #strBlue
       TextBoxLimiter(#strBlue, 255)
       udvGlobalTempColor\B = Val(GetGadgetText(#strBlue) )
       RGBToHSL201(0,#DontSplitRGB_But_UpdateCPgadgets)     
     Case #strHex
       udvGlobalTempColor\sHexColor = GetGadgetText(#strHex)
       RGBToHSL201(Hex2Dec(udvGlobalTempColor\sHexColor),#UpdateCPgadgets)
   EndSelect
 EndIf 
 
 ValuesToWinTitle(udvGlobalTempColor\H) ; Displaying the numbervalues on WinTitleBar.
 
 If OldRGB <> udvGlobalTempColor\RGB
   OldRGB = udvGlobalTempColor\RGB
   Select ColorCallingGadget
       Case #txt1 ; Obviously the calling window has got the declaration of this ColorCallingGadget so you have to launch the project from the calling window aka ColorPickerCallerDummy.pb.
         SetGadgetColor(#txt1, #PB_Gadget_BackColor, udvGlobalTempColor\RGB)       
       Case #txt2 ; Obviously the calling window has got the declaration of this ColorCallingGadget so you have to launch the project from the calling window aka ColorPickerCallerDummy.pb.
         SetGadgetColor(#txt2, #PB_Gadget_BackColor, udvGlobalTempColor\RGB)
   EndSelect
 EndIf
 
EndProcedure


Procedure CreateCPWin(); (*udvColorByRef.udtColorHSLrgba)
    Define i, s.s , sXY.s
    If WinColorpicker = 0 ; Create window if window doesn't exists.    
      WinColorpicker = OpenWindow(#PB_Any, 0, 0, #WinColpic_W265, #WinColpic_H265, "Colorpicker", #PB_Window_Tool)
      CanvasGadget(#cgtColorCanvas, 0, 0, #WinColpic_W265, #WinColpic_H265, #PB_Canvas_Container) ; CanvasGadget(#cgtColorCanvas, #Margin25, #Margin25, #CircleDiameter215, #CircleDiameter215)
      
      If CreateImage(#IMAGE_HueCirkel, #CircleDiameter215, #CircleDiameter215) And StartDrawing(ImageOutput(#IMAGE_HueCirkel))
        
        DrawingMode(#PB_2DDrawing_Gradient)
        Circle(107, 107, 107,  $FF0000FF)
        ConicalGradient(107, 107, 0)
        ResetGradientColors()
        
        GradientColor(0.0,  $0000FF) ;BGR RED
        GradientColor(0.16, $FF00FF) ;BGR LILA
        GradientColor(0.33, $FF0000) ;BGR BLUE
        GradientColor(0.49, $FFFF00) ;BGR TURKOS
        GradientColor(0.66, $00FF00) ;BGR GREEN
        GradientColor(0.83, $00FFFF) ;BGR YELLOW
        GradientColor(1.0,  $0000FF) ;BGR RED
        
        FillArea(123, 123, -1) ;BucketTool fyller här circle med transparens.    
        StopDrawing()
      EndIf 
      
      LoadFont(0, "Arial", 12, #PB_Font_HighQuality); | #PB_Font_Bold)  
      If StartDrawing(CanvasOutput(#cgtColorCanvas))
        
        DrawingFont(FontID(0))
        DrawingMode(#PB_2DDrawing_Transparent)
        
        
        Box(0,0,OutputWidth(), OutputWidth(), #Black) ; Svart Bakgrund!
        DrawImage(ImageID(#IMAGE_HueCirkel),#Margin25, #Margin25)
        
        ;==== Textboxar och Text ==========
        
        s="R,G,B,H"
        ;sXY="25,4,
        For i = #strRed To #strHex
          StringGadget(i, #Margin25 + 14 + ((i - #strRed) * 45), 2, 25,20,"", #PB_String_Numeric)
          SetGadgetColor(i, #PB_Gadget_BackColor, #Grey)
          DrawText(GadgetX(i)-14, 4, StringField(s,i+1-#strRed, ","), #Grey)
        Next i
        StringGadget(#strHex,GadgetX(#strHex),2,64,20,"") : SetGadgetColor(#strHex, #PB_Gadget_BackColor, #Grey)
        
        StringGadget(#strAlpha, #Margin25 + #CircleDiameter215 - 25, #Margin25 + #CircleDiameter215 + 4, 25, 20, "100", #PB_String_Numeric)
        SetGadgetColor(#strAlpha, #PB_Gadget_BackColor, #Grey)
        CheckBoxGadget(#chbAlpha, #Margin25 + 20, #WinColpic_H265 - 25, 20, 25,"")
        
        DrawText(GadgetX(#chbAlpha) + GadgetWidth(#chbAlpha) - 5, GadgetY(#chbAlpha) + 6, "A", #Grey)
        
        StringGadget(#strSaturation, 2, #Margin25 + #CircleDiameter215 - 20, 25, 20, "100", #PB_String_Numeric)
        SetGadgetColor(#strSaturation, #PB_Gadget_BackColor, #Grey)
        DrawRotatedText(25, GadgetY(#strSaturation) + 19 , "Sat", 90, #Grey)
        
        StringGadget(#strLuma, #WinColpic_W265 - 25, #Margin25 + #CircleDiameter215 - 20, 25, 20, "100", #PB_String_Numeric)
        SetGadgetColor(#strLuma, #PB_Gadget_BackColor, #Grey)
        DrawRotatedText(GadgetX(#strLuma) - 20, GadgetY(#strLuma) + 19 , "Luma", 90, #Grey)
        
        StopDrawing()
      EndIf
    EndIf
    HSLToRGB(@udvGlobalTempColor, #UpdateCPgadgets)        ; Denna rutin uppdaterar alla gadgets utom sliders.
    DrawSatSlider  (udvGlobalTempColor\S, #ValueIsPercent) ; Uppdaterar sliders.
    DrawAlphaSlider(99)
    DrawLumaSlider (udvGlobalTempColor\L, #ValueIsPercent)
    ValuesToWinTitle(udvGlobalTempColor\H) 
   
 EndProcedure
   
   ;PopulateCPWin()
    
    ;SetGadgetAttribute(#cgtColorCanvas,#PB_Canvas_Image , ImageID(#IMAGE_HueCirkel))

   ;EndIf ; CreateImage(#IMAGE_Text, 215, 215
  ;EndIf ; OpenWindow(0, 0, 0, 265, 265, "2DDrawing Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

Newbie
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: ColorPicker ColorWheel

Post by BarryG »

I put both codes into one compilable source below for quick testing. Added keywords for searches: color colour wheel picker colourwheel colourpicker (alt spellings).

Image

Code: Select all

#txt1=1 ; Beware of not useing the same ID-numbers as the gadgets in Colopicker.
#txt2=2

;Metrics
#WinColpic_W265 = 265
#WinColpic_H265 = 265
#Margin25 = 25

#SaturationSliderX = 2

#CircleDiameter215=215
#AlphaSliderX = #Margin25  + 50
#AlphaSliderY = #WinColpic_H265 - 20
#AlphaSliderW = #CircleDiameter215 - 80

#LumaSliderX = #WinColpic_W265 - 22
#LumaSliderY = 25
#LumaSliderH = #WinColpic_H265 - 75

#IMAGE_HueCirkel=0
;#IMAGE_Text=1

Enumeration GADGETS
  #cgtColorCanvas=3
  #strRed
  #strGreen
  #strBlue
  #strHex
  #strSaturation
  #strAlpha
  #strLuma
  #chbAlpha
EndEnumeration

#Grey =  200 + 200*256 + 200*65536
#GreyRGBA = #Grey | 255 << 24 ; 255 innebär helt opaque.
#WhiteRGBA = #White | 255 << 24 ; 255 innebär helt opaque.

;FLAGS
#ZoneCircle =           1
#ZoneSaturationSlider = 2
#ZoneAlphaSlider =      3
#ZoneLumaSlider =       4
#UpdateCPgadgets =      5
#DontSplitRGB =         6
#DontSplitRGB_But_UpdateCPgadgets=7
#ValueIsPercent =       8
#JustWantRGBfromHSL =   9

Structure udtColorHSLrgba
  RGB.l ;
  RGBA.l
  sHexColor.s
  R.l ; 255
  G.l ; 255
  B.l ; 255
  A.l ; 255
  H.l ; Hue 360 degrees.
  S.l ; Saturation %
  L.l ; Luminocity %
EndStructure

Define Event,x,y, XfromOrigo, YfromOrigo, HueDegrees, x
Global WinColorpicker, HueAngle.f, ActiveColorItem, udvGlobalTempColor.udtColorHSLrgba, ColorCallingGadget

Declare.l DrawSatSlider(y, Flag=0) ; To let the program call DrawSatSlider() from south & north.
Declare.l DrawLumaSlider(y, Flag=0); To let the program call DrawSatSlider() from south & north.


Procedure ValuesToWinTitle(HueDegrees)
  ;Debug HueAngle
  SetWindowTitle(WinColorpicker, "Hue = " + Str(HueDegrees) + "; Sat = " + GetGadgetText(#strSaturation) + "; L = " + GetGadgetText(#strLuma) + "; A = " + GetGadgetText(#strAlpha))
  
EndProcedure

Procedure TextBoxLimiter(Gadget, Max)
  
  If Val(GetGadgetText(Gadget)) > Max
    SetGadgetText(Gadget, Str(Max))
  EndIf
  
EndProcedure

Procedure.l Hex2Dec(hex.s)
  Define r, d, a.s
  For r=1 To Len(hex.s)
    d<<4 : a.s=Mid(hex.s,r,1)
    If Asc(a.s)>60
      d+Asc(a.s)-55
    Else
      d+Asc(a.s)-48
    EndIf
  Next
  ProcedureReturn d
EndProcedure


Procedure.l HSLToRGB(*udvColorByRef.udtColorHSLrgba, Flag); As Long
                                                          ;HSLToRGB(LocalColorAngle.l, Saturation.l, Luminance.l, Flag); As Long
  Define R.l, G.l, B.l, lMax.l, lMid.l, lMin.l, q.f, LocalColorAngle
  ;Debug "HSLToRGB" + Str(*udvColorByRef\L) + "  Flag = " + Str(Flag)
  ;If    *udvColorByRef\L = 100 : Debug "DrawSliderLuma använder HSL för att skapa sliderns toppfärg." : EndIf
  
  lMax = *udvColorByRef\L * 2.55 ;: Debug "*udvColorByRef\H " + Str(*udvColorByRef\H)
  lMin = (255 - (*udvColorByRef\S * 2.55)) * lMax / 255 ; 255 - (Saturation * lMax / 255)
  q = (lMax - lMin) / 255
  
  LocalColorAngle = *udvColorByRef\H ;Hue degrees.
  LocalColorAngle = LocalColorAngle * 4.25 ; Gör att 1530 motsvarar 360 grader.
  
  Select LocalColorAngle
    Case 0 To 255
      lMid = (LocalColorAngle - 0) * q + lMin
      R = lMax: G = lMid: B = lMin
    Case 256 To 510 ;This period surpasses the node border with one unit - over to gren color. CHECK by F8.
      lMid = -(LocalColorAngle - 255) * q + lMax ;-(LocalColorAngle - 256) * q + lMin
      R = lMid: G = lMax: B = lMin
    Case 511 To 765
      lMid = (LocalColorAngle - 510) * q + lMin
      R = lMin: G = lMax: B = lMid
    Case 766 To 1020
      lMid = -(LocalColorAngle - 765) * q + lMax
      R = lMin: G = lMid: B = lMax
    Case 1021 To 1275
      lMid = (LocalColorAngle - 1020) * q + lMin
      R = lMid: G = lMin: B = lMax
    Case 1276 To 1530
      lMid = -(LocalColorAngle - 1275) * q + lMax
      R = lMax: G = lMin: B = lMid
    Default
      MessageRequester("Msg","Error occured in HSLToRGB. intSystemColorAngleMax1530= " + Str(LocalColorAngle))
  EndSelect
  
  *udvColorByRef\RGB = RGB(R,G,B)
  If flag <> #JustWantRGBfromHSL ; ============================================================
    *udvColorByRef\R = R
    *udvColorByRef\G = G
    *udvColorByRef\B = B
    *udvColorByRef\RGBA = RGBA(R,G,B, *udvColorByRef\A)
    
    ; ============ HEXADECIMAL FORMATERING ============
    If R < 16;&H10
             ;txtHexColor = Right$("00000" & Hex$(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue), 6) ;Padding with zeroletters to the left.
      *udvColorByRef\sHexColor = Right("00000" + Hex(R * 65536 + G * 256 + B), 6)
    Else
      ;txtHexColor = Hex$(mSngRValue * 65536 + mSngGValue * 256 + mSngBValue)
      *udvColorByRef\sHexColor = Hex(R * 65536 + G * 256 + B)
    EndIf
    
    ;---- OPTIONAL UPDATING GADGETS! -------------------
    If Flag = #UpdateCPgadgets   
      SetGadgetText(#strRed,   Str(R))
      SetGadgetText(#strGreen, Str(G))
      SetGadgetText(#strBlue,  Str(B))
      SetGadgetText(#strHex, *udvColorByRef\sHexColor)
    EndIf ; Angående Flag = #UpdateCPgadgets
    
    DrawLumaSlider(*udvColorByRef\L, #ValueIsPercent) ; Uppdaterar kulören på slidern.
    DrawSatSlider(*udvColorByRef\S, #ValueIsPercent)  ; Uppdaterar kulören på slidern.
    
  EndIf ; Angående flag <> #JustWantRGBfromHSL.
  
  ProcedureReturn *udvColorByRef\RGB ; HSLToRGB = RGB(R,G,B) ; Delivers lngColor in RGB-format.
  
EndProcedure

Procedure RGBToHSL201(RGBValue.l, Flag);, RGBToHSL.HSL); As HSL
  Define R.l, G.l, B.l, lMax.l, lMin.l, lDiff.l, lSum.l, q.f;float.
                                                            ;Debug "RGBToHSL201()"
                                                            ;Define udtAngelSaturationBrightness.HSL
                                                            ;Define RGBToHSL.HSL
  
  If Flag = #DontSplitRGB Or Flag = #DontSplitRGB_But_UpdateCPgadgets; Already accurate values in udvGlobalTempColor.
    R = udvGlobalTempColor\R
    G = udvGlobalTempColor\G
    B = udvGlobalTempColor\B
  Else
    R = Red(RGBValue)
    G = Green(RGBValue)
    B = Blue(RGBValue)
  EndIf
  
  If R > G
    lMax = R: lMin = G
  Else
    lMax = G: lMin = R ;Finds the Superior and inferior components.
  EndIf
  
  If B > lMax
    lMax = B
  Else
    If B < lMin
      lMin = B
    EndIf
  EndIf
  
  lDiff = lMax - lMin
  lSum = lMax + lMin
  ;Luminance, thus brightness; Adobe photoshop uses the logic that the site VBspeed.com has regarded as too primitive = superior decides the level of brightness.
  udvGlobalTempColor\L = lMax / 255 * 100
  ;Saturation******
  If lMax <> 0;Protecting from the impossible operation of division by zero.
    udvGlobalTempColor\S = 100 * lDiff / lMax ;The logic of Adobe Photoshops is this simple.
  Else
    udvGlobalTempColor\S = 0
  EndIf
  ;Hue ************** R is situated at the angel of 360 or zero degrees; G vid 120 degrees; B vid 240 degrees. intSystemColorAngleMax1530
  
  If lDiff = 0
    q = 0
  Else
    q = 60 / lDiff ;Protecting from the impossible operation of division by zero.
  EndIf
  Select lMax
    Case R
      If G < B
        udvGlobalTempColor\H = 360 + q * (G - B)
        ;intSystemColorAngleMax1530 = (360 + q * (G - B)) * 4.25 ;Converting from degrees to my resolution of detail.
      Else
        udvGlobalTempColor\H = q * (G - B)
        ;intSystemColorAngleMax1530 = (q * (G - B)) * 4.25
      EndIf
    Case G
      udvGlobalTempColor\H = 120 + q * (B - R) ; (R - G)
                                               ;intSystemColorAngleMax1530 = (120 + q * (B - R)) * 4.25
    Case B
      udvGlobalTempColor\H = 240 + q * (R - G)
      ;intSystemColorAngleMax1530 = (240 + q * (R - G)) * 4.25
  EndSelect ;The case of B was missing.
  
  ;---- OPTIONAL UPDATING GADGETS! -------------------
  If Flag = #UpdateCPgadgets Or Flag = #DontSplitRGB_But_UpdateCPgadgets
    SetGadgetText(#strSaturation, Str(udvGlobalTempColor\S))
    SetGadgetText(#strLuma, Str(udvGlobalTempColor\L))
    udvGlobalTempColor\RGB  = RGB(R,G,B)
    udvGlobalTempColor\RGBA = RGBA(R,G,B, udvGlobalTempColor\A )
    SetGadgetText(#strRed,   Str(R)) : udvGlobalTempColor\R = R
    SetGadgetText(#strGreen, Str(G)) : udvGlobalTempColor\G = G
    SetGadgetText(#strBlue,  Str(B)) : udvGlobalTempColor\B = B
    
    ;txtHexColor = Hex$(R * 65536 + G * 256 + B): txtHexColor.Refresh ;Applying To internetstandard<>VBstandard
    If R < 16;&H10
             ;txtHexColor = Right$("00000" & Hex$(R * 65536 + G * 256 + B), 6) ;Adds letters of zero to the left which is a necessary so called padding.
      udvGlobalTempColor\sHexColor = Right("00000" + Hex(R * 65536 + G * 256 + B), 6)
    Else
      ;txtHexColor = Hex$(R * 65536 + G * 256 + B)
      udvGlobalTempColor\sHexColor = Hex(R * 65536 + G * 256 + B)
    EndIf
    
    SetGadgetText(#strHex, udvGlobalTempColor\sHexColor)
    DrawSatSlider(udvGlobalTempColor\S, #ValueIsPercent)
    DrawLumaSlider(udvGlobalTempColor\L, #ValueIsPercent)
    
  EndIf
  
  
EndProcedure


Procedure.l DrawSatSlider(y, Flag=0)
  Define Percent.f, Greyness, udvSat_SliderColor.udtColorHSLrgba
  
  If Flag = #ValueIsPercent
    y = #LumaSliderY +  #LumaSliderH - (#LumaSliderH * y / 100) ; Lumaslider has identical metrics to SaturationSlider.
  Else
    If y < #LumaSliderY
      y = #LumaSliderY
    ElseIf y > #LumaSliderY + #LumaSliderH
      y = #LumaSliderY + #LumaSliderH
    EndIf; SatirationSlider och LumaSlider har samma y-dimensioner.
  EndIf
  
  If StartDrawing( CanvasOutput(#cgtColorCanvas) )
    Box(#SaturationSliderX, #LumaSliderY, 20, #LumaSliderH, #White) ; Vit bakgrund.
    
    DrawingMode(#PB_2DDrawing_Gradient)
    udvSat_SliderColor   = udvGlobalTempColor ; udvGlobalTempColor is only used in ColorPickerWindow as an internal messenger.
    udvSat_SliderColor\S = 100                ; Max saturation.
    
    BackColor(HSLToRGB(@udvSat_SliderColor, #JustWantRGBfromHSL)) ; Gosub calculate RGB with max saturation.   
    Greyness = (255 * udvGlobalTempColor\L)/100
    FrontColor(RGB( Greyness,Greyness,Greyness))
    
    LinearGradient(#SaturationSliderX, #LumaSliderY, #SaturationSliderX + 20, #LumaSliderY + #LumaSliderH)
    Box(#SaturationSliderX, #LumaSliderY, 20, #LumaSliderH)
    
    DrawingMode(#PB_2DDrawing_Default)
    ;Box(x, #AlphaSliderY, #AlphaSliderW - (x - #AlphaSliderX),18,#White) ; Vitt fält som följer tracker.
    Box(#SaturationSliderX, y-3, 18, 5,#Red) ; Thumb aka tracker.
    StopDrawing()
  EndIf
  Percent = ((#LumaSliderY + #LumaSliderH - y) / #LumaSliderH) * 100
  
  ProcedureReturn  Percent; Ger noll vid minimum och 100% vid max.
EndProcedure


Procedure.l DrawLumaSlider(y, Flag=0)
  Define Percent.f, udvLumaSliderColor.udtColorHSLrgba
  ; Lumaslider has always gradient from maxLuma to Black.
  
  If Flag = #ValueIsPercent
    y = #LumaSliderY +  #LumaSliderH - (#LumaSliderH * y / 100)
  Else
    If y < #LumaSliderY
      y = #LumaSliderY
    ElseIf y > #LumaSliderY + #LumaSliderH
      y = #LumaSliderY + #LumaSliderH
    EndIf
  EndIf
  
  If StartDrawing( CanvasOutput(#cgtColorCanvas) )
    Box(#LumaSliderX, #LumaSliderY, 20, #LumaSliderH, #White) ; Vit bakgrund.
    
    DrawingMode(#PB_2DDrawing_Gradient)
    ;       BackColor(RGB($40,$40,$40))
    ;       FrontColor(RGB($DD,$DD,$DD))
    udvLumaSliderColor   = udvGlobalTempColor ; udvGlobalTempColor is only used in ColorPickerWindow as an internal messenger.
    udvLumaSliderColor\L = 100                ; Max Luma.
                                              ;HSLToRGB(@udvLumaSliderColor, #DontSplitRGB)
    BackColor(HSLToRGB(@udvLumaSliderColor, #JustWantRGBfromHSL)) ; Gosub calculate RGB with max Luma.
    FrontColor(#Black)
    
    LinearGradient(#LumaSliderX, #LumaSliderY, #LumaSliderX + 20, #LumaSliderY + #LumaSliderH)
    Box(#LumaSliderX, #LumaSliderY, 20, #LumaSliderH)
    
    DrawingMode(#PB_2DDrawing_Default)
    ;Box(x, #AlphaSliderY, #AlphaSliderW - (x - #AlphaSliderX),18,#White) ; Vitt fält som följer tracker.
    Box(#LumaSliderX, y-3, 18, 5,#Red) ; Thumb aka tracker.
    StopDrawing()
  EndIf
  Percent = ((#LumaSliderY + #LumaSliderH - y) / #LumaSliderH) * 100
  
  ProcedureReturn  Percent; Ger noll vid minimum och 100% vid max.
EndProcedure

Procedure DrawAlphaSlider(x)
  Define Percent.f
  
  If x < #AlphaSliderX
    x = #AlphaSliderX
  ElseIf x > #AlphaSliderX + #AlphaSliderW
    x = #AlphaSliderX + #AlphaSliderW
  EndIf
  
  If StartDrawing( CanvasOutput(#cgtColorCanvas) )
    Box(#AlphaSliderX, #AlphaSliderY, #AlphaSliderW, 18, #White) ; Vit bakgrund.
    
    DrawingMode(#PB_2DDrawing_Gradient)
    BackColor(RGB($40,$40,$40))
    FrontColor(RGB($DD,$DD,$DD))
    
    LinearGradient(#AlphaSliderX, #AlphaSliderY, #AlphaSliderX + #AlphaSliderW, #AlphaSliderY + 18)
    Box(#AlphaSliderX, #AlphaSliderY, #AlphaSliderW, 18)
    
    DrawingMode(#PB_2DDrawing_Default)
    ;Box(x, #AlphaSliderY, #AlphaSliderW - (x - #AlphaSliderX),18,#White) ; Vitt fält som följer tracker.
    Box(x-3, #AlphaSliderY, 5,18,#Red) ; Thumb aka tracker.
    StopDrawing()
  EndIf
  
  Percent = ((x - #AlphaSliderX) / #AlphaSliderW) * 100
  
  ProcedureReturn  Percent; Ger noll vid minimum och 100% vid max.
EndProcedure


Procedure.l CPzonedetector(x,y)
  Define Zone
  
  If x > #SaturationSliderX And x < #SaturationSliderX + 18 ; LumaSlider har samma mått som #SaturationSliderX.
    If y > #LumaSliderY And y < #LumaSliderY + #LumaSliderH
      ProcedureReturn #ZoneSaturationSlider
    EndIf
  EndIf
  
  If x > #Margin25 And x < #Margin25 + #CircleDiameter215
    If y > #Margin25 And y < #Margin25 + #CircleDiameter215
      ;Zone = #ZoneCircle
      ProcedureReturn #ZoneCircle
    EndIf
  EndIf
  
  If x > #AlphaSliderX And x < #AlphaSliderX + #AlphaSliderW
    If y > #AlphaSliderY And y < #AlphaSliderY + 18
      ;Zone = #ZoneAlphaSlider
      ProcedureReturn #ZoneAlphaSlider
    EndIf
  EndIf
  
  If x > #LumaSliderX And x < #LumaSliderX + 18
    If y > #LumaSliderY And y < #LumaSliderY + #LumaSliderH
      ProcedureReturn #ZoneLumaSlider
    EndIf
  EndIf
  
  ProcedureReturn 0 ; NoZone = Zero.
EndProcedure

Procedure.l MouseOnCanvasReaction(x,y)
  Define XfromOrigo, YfromOrigo, SliderPercent, Value
  Protected HueDegrees
  XfromOrigo = x - 132 ; 107
  YfromOrigo = 132 - y
  
  Select ActiveColorItem
    Case #ZoneCircle
      If XfromOrigo = 0 And YfromOrigo < 0 ; Skyddar från omöjlig nolldivision.
        HueAngle = 270
      ElseIf XfromOrigo = 0 And YfromOrigo > 0
        HueAngle = 90
      ElseIf XfromOrigo + YfromOrigo = 0
        HueAngle = 0
      Else
        HueAngle = Degree(ATan(YfromOrigo/XfromOrigo))
        If XfromOrigo>0 And YfromOrigo > 0: HueDegrees = HueAngle
        ElseIf XfromOrigo<0 And YfromOrigo > 0: HueDegrees = 180 + HueAngle
        ElseIf XfromOrigo<0 And YfromOrigo < 0: HueDegrees = 180 + HueAngle
        ElseIf XfromOrigo>0 And YfromOrigo < 0: HueDegrees = 360 + HueAngle
        EndIf
      EndIf
      udvGlobalTempColor\H = HueDegrees ; 0 - 360 degrees.
    Case #ZoneSaturationSlider
      SliderPercent = DrawSatSlider(y) ; procedurereturn value i %.
      SetGadgetText(#strSaturation, Str(SliderPercent))
      udvGlobalTempColor\S = SliderPercent ; * 2.55;? ; Windows uses 0-255 regarding Alpha so I'll do the same with the imaginary Saturation and Luma.
    Case #ZoneAlphaSlider
      SliderPercent = DrawAlphaSlider(x) ; procedurereturn value i %.
      SetGadgetText(#strAlpha, Str(SliderPercent))
      udvGlobalTempColor\A = SliderPercent ; * 2.55;?
    Case #ZoneLumaSlider
      SliderPercent = DrawLumaSlider(y) ; procedurereturn value i %.
      SetGadgetText(#strLuma, Str(SliderPercent))
      udvGlobalTempColor\L = SliderPercent ; * 2.55;?
  EndSelect                                ; ActiveColorItem CPzonedetector() 
  
  If ActiveColorItem <> #ZoneCircle : HueDegrees = udvGlobalTempColor\H : EndIf ; No change.
  HSLToRGB(@udvGlobalTempColor,#UpdateCPgadgets)                                ; ByRef för ibland vill vi använda fejkade värden.
  
  
  ProcedureReturn HueDegrees
  
EndProcedure

Procedure MouseOnColorPickerWin(EvGadget, eTyp)
  Define x, y, Value, FlagUserChanged_HSL, FlagUserChanged_RGBA
  Static HueDegrees, OldRGB
  x = GetGadgetAttribute(#cgtColorCanvas, #PB_Canvas_MouseX)
  y = GetGadgetAttribute(#cgtColorCanvas, #PB_Canvas_MouseY)
  
  OldRGB = udvGlobalTempColor\RGB
  
  Select EvGadget
    Case  #cgtColorCanvas
      If eTyp = #PB_EventType_LeftButtonDown
        ActiveColorItem = CPzonedetector(x,y) ; Only the first mousedown (not drag). Detect colorcircel or sliders and update the flag ActiveColorItem.
        If ActiveColorItem : HueDegrees = MouseOnCanvasReaction(x,y) : EndIf
      EndIf
      If eTyp = #PB_EventType_MouseMove And GetGadgetAttribute(#cgtColorCanvas, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
        HueDegrees = MouseOnCanvasReaction(x,y) : FlagUserChanged_HSL = 1 ; MouseOnCanvasReaction() handles also the sliders.
      EndIf
  EndSelect
  
  If eTyp = #PB_EventType_Change ; React if user changed content of txtboxes.
    Select EvGadget
      Case #strSaturation
        Value = Val(GetGadgetText(#strSaturation)) ; Converting percent to pixelpositions.
        Value = #LumaSliderY + #LumaSliderH - ((Value * #LumaSliderH) / 100) ; LumaSlider and SaturationSlider have identical dimensions.
        DrawSatSlider(Value)
        FlagUserChanged_HSL = 1
      Case #strAlpha
        Value = Val(GetGadgetText(#strAlpha)) ; Converting percent to pixelpositions.
        Value = ((Value * #AlphaSliderW) / 100) + #AlphaSliderX ; LumaSlider and SaturationSlider have identical dimensions.
        DrawAlphaSlider(Value)
      Case #strLuma
        Value = Val(GetGadgetText(#strLuma)) ; Converting percent to pixelpositions.
        Value = #LumaSliderY + #LumaSliderH - ((Value * #LumaSliderH) / 100) ; LumaSlider and SaturationSlider have identical dimensions.
        DrawLumaSlider(Value)
        FlagUserChanged_HSL = 1
      Case #chbAlpha
        If GetGadgetState(#chbAlpha)
          DisableGadget(#strAlpha,0)
        Else
          DisableGadget(#strAlpha,1)
        EndIf
      Case #strRed
        TextBoxLimiter(#strRed, 255)
        udvGlobalTempColor\R = Val(GetGadgetText(#strRed))
        RGBToHSL201(0,#DontSplitRGB_But_UpdateCPgadgets)
      Case #strGreen
        TextBoxLimiter(#strGreen, 255)
        udvGlobalTempColor\G = Val(GetGadgetText(#strGreen))
        RGBToHSL201(0,#DontSplitRGB_But_UpdateCPgadgets)
      Case #strBlue
        TextBoxLimiter(#strBlue, 255)
        udvGlobalTempColor\B = Val(GetGadgetText(#strBlue) )
        RGBToHSL201(0,#DontSplitRGB_But_UpdateCPgadgets)     
      Case #strHex
        udvGlobalTempColor\sHexColor = GetGadgetText(#strHex)
        RGBToHSL201(Hex2Dec(udvGlobalTempColor\sHexColor),#UpdateCPgadgets)
    EndSelect
  EndIf
  
  ValuesToWinTitle(udvGlobalTempColor\H) ; Displaying the numbervalues on WinTitleBar.
  
  If OldRGB <> udvGlobalTempColor\RGB
    OldRGB = udvGlobalTempColor\RGB
    Select ColorCallingGadget
      Case #txt1 ; Obviously the calling window has got the declaration of this ColorCallingGadget so you have to launch the project from the calling window aka ColorPickerCallerDummy.pb.
        SetGadgetColor(#txt1, #PB_Gadget_BackColor, udvGlobalTempColor\RGB)       
      Case #txt2 ; Obviously the calling window has got the declaration of this ColorCallingGadget so you have to launch the project from the calling window aka ColorPickerCallerDummy.pb.
        SetGadgetColor(#txt2, #PB_Gadget_BackColor, udvGlobalTempColor\RGB)
    EndSelect
  EndIf
  
EndProcedure


Procedure CreateCPWin(); (*udvColorByRef.udtColorHSLrgba)
  Define i, s.s , sXY.s
  If WinColorpicker = 0 ; Create window if window doesn't exists.   
    WinColorpicker = OpenWindow(#PB_Any, 0, 0, #WinColpic_W265, #WinColpic_H265, "Colorpicker", #PB_Window_Tool)
    CanvasGadget(#cgtColorCanvas, 0, 0, #WinColpic_W265, #WinColpic_H265, #PB_Canvas_Container) ; CanvasGadget(#cgtColorCanvas, #Margin25, #Margin25, #CircleDiameter215, #CircleDiameter215)
    
    If CreateImage(#IMAGE_HueCirkel, #CircleDiameter215, #CircleDiameter215) And StartDrawing(ImageOutput(#IMAGE_HueCirkel))
      
      DrawingMode(#PB_2DDrawing_Gradient)
      Circle(107, 107, 107,  $FF0000FF)
      ConicalGradient(107, 107, 0)
      ResetGradientColors()
      
      GradientColor(0.0,  $0000FF) ;BGR RED
      GradientColor(0.16, $FF00FF) ;BGR LILA
      GradientColor(0.33, $FF0000) ;BGR BLUE
      GradientColor(0.49, $FFFF00) ;BGR TURKOS
      GradientColor(0.66, $00FF00) ;BGR GREEN
      GradientColor(0.83, $00FFFF) ;BGR YELLOW
      GradientColor(1.0,  $0000FF) ;BGR RED
      
      FillArea(123, 123, -1) ;BucketTool fyller här circle med transparens.   
      StopDrawing()
    EndIf
    
    LoadFont(0, "Arial", 12, #PB_Font_HighQuality); | #PB_Font_Bold) 
    If StartDrawing(CanvasOutput(#cgtColorCanvas))
      
      DrawingFont(FontID(0))
      DrawingMode(#PB_2DDrawing_Transparent)
      
      
      Box(0,0,OutputWidth(), OutputWidth(), #Black) ; Svart Bakgrund!
      DrawImage(ImageID(#IMAGE_HueCirkel),#Margin25, #Margin25)
      
      ;==== Textboxar och Text ==========
      
      s="R,G,B,H"
      ;sXY="25,4,
      For i = #strRed To #strHex
        StringGadget(i, #Margin25 + 14 + ((i - #strRed) * 45), 2, 25,20,"", #PB_String_Numeric)
        SetGadgetColor(i, #PB_Gadget_BackColor, #Grey)
        DrawText(GadgetX(i)-14, 4, StringField(s,i+1-#strRed, ","), #Grey)
      Next i
      StringGadget(#strHex,GadgetX(#strHex),2,64,20,"") : SetGadgetColor(#strHex, #PB_Gadget_BackColor, #Grey)
      
      StringGadget(#strAlpha, #Margin25 + #CircleDiameter215 - 25, #Margin25 + #CircleDiameter215 + 4, 25, 20, "100", #PB_String_Numeric)
      SetGadgetColor(#strAlpha, #PB_Gadget_BackColor, #Grey)
      CheckBoxGadget(#chbAlpha, #Margin25 + 20, #WinColpic_H265 - 25, 20, 25,"")
      
      DrawText(GadgetX(#chbAlpha) + GadgetWidth(#chbAlpha) - 5, GadgetY(#chbAlpha) + 6, "A", #Grey)
      
      StringGadget(#strSaturation, 2, #Margin25 + #CircleDiameter215 - 20, 25, 20, "100", #PB_String_Numeric)
      SetGadgetColor(#strSaturation, #PB_Gadget_BackColor, #Grey)
      DrawRotatedText(25, GadgetY(#strSaturation) + 19 , "Sat", 90, #Grey)
      
      StringGadget(#strLuma, #WinColpic_W265 - 25, #Margin25 + #CircleDiameter215 - 20, 25, 20, "100", #PB_String_Numeric)
      SetGadgetColor(#strLuma, #PB_Gadget_BackColor, #Grey)
      DrawRotatedText(GadgetX(#strLuma) - 20, GadgetY(#strLuma) + 19 , "Luma", 90, #Grey)
      
      StopDrawing()
    EndIf
  EndIf
  HSLToRGB(@udvGlobalTempColor, #UpdateCPgadgets)        ; Denna rutin uppdaterar alla gadgets utom sliders.
  DrawSatSlider  (udvGlobalTempColor\S, #ValueIsPercent) ; Uppdaterar sliders.
  DrawAlphaSlider(99)
  DrawLumaSlider (udvGlobalTempColor\L, #ValueIsPercent)
  ValuesToWinTitle(udvGlobalTempColor\H)
  
EndProcedure

Define Wev, EventWindow, EvGadget, eTyp

OpenWindow(0, 0, 0, 300, 200, "ColorPickerCaller", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TextGadget(#txt1, 125,  50, 50, 50, "", #PB_Text_Border | 256) ; 256 är nödvändig för att kunna känna click.
SetGadgetColor(#txt1,#PB_Gadget_BackColor,#Red)
TextGadget(#txt2, 125,  120, 50, 50, "", #PB_Text_Border | 256) ; 256 är nödvändig för att kunna känna click.
SetGadgetColor(#txt2,#PB_Gadget_BackColor,#Green)

Define udvColor1.udtColorHSLrgba
Define udvColor2.udtColorHSLrgba

udvColor1\H = 0 ; HueAngle Zero means #Red. Theses values would normally be saved/retrieved from an ini-file.
udvColor1\S = 100 ; %
udvColor1\L = 100 ; %

udvColor2\H = 120 ; HueAngle 120 means #Green. Theses values would normally be saved/retrieved from an ini-file.
udvColor2\S = 100 ; %
udvColor2\L = 100 ; %

Repeat
  Wev = WaitWindowEvent() ; Testar för systemhändelser.
  EventWindow = EventWindow()
  EvGadget=EventGadget()
  eTyp = EventType()
  
  If Wev = #PB_Event_Gadget               ; If user clicks or drags on the gadgets of ColorPickerWindow...
    Select EvGadget
      Case #cgtColorCanvas
        MouseOnColorPickerWin(EvGadget, eTyp)   ; Gosub Colorpicker.
      Case #strRed To #chbAlpha                 ; StringGadgets ion ColorpickerWindow.
        If eTyp = #PB_EventType_Change
          MouseOnColorPickerWin(EvGadget, eTyp) ; Gosub Colorpicker.
        EndIf
      Case #txt1
        ColorCallingGadget = #txt1
        udvGlobalTempColor = udvColor1 ; udvGlobalTempColor is only used in ColorPickerWindow as an internal messenger.
        CreateCPWin()   
      Case #txt2
        ColorCallingGadget = #txt2
        udvGlobalTempColor = udvColor2
        CreateCPWin()
    EndSelect
  EndIf
  
Until Wev = #PB_Event_CloseWindow
Post Reply