Code: Select all
EnableExplicit
;- Include
Structure ColorGadget_HSVA
Hue.f
Saturation.f
Value.f
Alpha.i
EndStructure
#ColorGadget_ChannelSize = 24
Procedure.i ColorGadget_Max(Value1.i=0, Value2.i=0, Value3.i=0, Value4.i=0)
Protected MaxValue.i = 0
If Value1 > MaxValue : MaxValue = Value1 : EndIf
If Value2 > MaxValue : MaxValue = Value2 : EndIf
If Value3 > MaxValue : MaxValue = Value3 : EndIf
If Value4 > MaxValue : MaxValue = Value4 : EndIf
ProcedureReturn MaxValue
EndProcedure
Procedure.i ColorGadget_Min(Value1.i=255, Value2.i=255, Value3.i=255, Value4.i=255)
Protected MinValue.i = 255
If Value1 < MinValue : MinValue = Value1 : EndIf
If Value2 < MinValue : MinValue = Value2 : EndIf
If Value3 < MinValue : MinValue = Value3 : EndIf
If Value4 < MinValue : MinValue = Value4 : EndIf
ProcedureReturn MinValue
EndProcedure
Procedure.l ColorGadget_SetHSVA(Hue.f, Saturation.f, Value.f, Alpha.i=255) ; [0,360[, [0,1], [0,255]
If Hue < 0 : Hue = 0 : ElseIf Hue >= 360 : Hue = 360 : EndIf
If Saturation > 1.0 : Saturation = 1.0 : ElseIf Saturation < 0.0 : Saturation = 0.0 : EndIf
If Value > 255 : Value = 255 : ElseIf Value < 0 : Value = 0 : EndIf
If Alpha > 255 : Alpha = 255 : ElseIf Alpha < 0 : Alpha = 0 : EndIf
Protected H.i = Int(Hue/60)
Protected f.f = (Hue/60-H)
Protected p.i = Value * (1-Saturation)
Protected q.i = Value * (1-Saturation*f)
Protected t.i = Value * (1-Saturation*(1-f))
Select H
Case 1 : ProcedureReturn RGBA(q,Value,p,Alpha)
Case 2 : ProcedureReturn RGBA(p,Value,t,Alpha)
Case 3 : ProcedureReturn RGBA(p,q,Value,Alpha)
Case 4 : ProcedureReturn RGBA(t,p,Value,Alpha)
Case 5 : ProcedureReturn RGBA(Value,p,q,Alpha)
Default : ProcedureReturn RGBA(Value,t,p,Alpha)
EndSelect
EndProcedure
Procedure ColorGadget_GetHVSA(Color.l, *HSVA.ColorGadget_HSVA)
Protected Max.i = ColorGadget_Max(Red(Color),Green(Color),Blue(Color))
Protected Min.i = ColorGadget_Min(Red(Color),Green(Color),Blue(Color))
*HSVA\Value = Max
If Max = 0 : *HSVA\Saturation = 0 : Else : *HSVA\Saturation = (Max-Min)/Max : EndIf
If Max = Min
*HSVA\Hue = 0
ElseIf Max = Red(Color)
*HSVA\Hue = 60.0*( (Green(Color)-Blue(Color))/(Max-Min))
If *HSVA\Hue < 0 : *HSVA\Hue + 360 : EndIf
ElseIf Max = Green(Color)
*HSVA\Hue = 60.0*(2+(Blue(Color)-Red(Color))/(Max-Min))
Else
*HSVA\Hue = 60.0*(4+(Red(Color)-Green(Color))/(Max-Min))
EndIf
*HSVA\Alpha = Alpha(Color)
EndProcedure
Procedure DrawColorGadget(Gadget.i, Color.l)
Protected BoxWidth.i, BoxHeight.i, X.i, Y.i, Alpha.i
Protected HSVA.ColorGadget_HSVA
ColorGadget_GetHVSA(Color, @HSVA)
If StartDrawing(CanvasOutput(Gadget))
BoxWidth = OutputWidth()-#ColorGadget_ChannelSize-1
BoxHeight = OutputHeight()-#ColorGadget_ChannelSize-1
Box(0, 0, BoxWidth+1, BoxHeight+1, ColorGadget_SetHSVA(HSVA\Hue, 1, 255))
DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AlphaBlend)
LinearGradient(0, 0, 0, BoxHeight)
GradientColor(0.0, $FFFFFFFF) : GradientColor(1.0, $00FFFFFF)
Box(0, 0, BoxWidth+1, BoxHeight+1)
LinearGradient(0, 0, BoxWidth, 0)
ResetGradientColors()
GradientColor(0.0, $FF000000) : GradientColor(1.0, $00000000)
Box(0, 0, BoxWidth+1, BoxHeight+1)
DrawingMode(#PB_2DDrawing_XOr)
Box(HSVA\Value*BoxWidth/255-1, HSVA\Saturation*BoxHeight-5, 3, 11)
Box(HSVA\Value*BoxWidth/255-5, HSVA\Saturation*BoxHeight-1, 11, 3)
DrawingMode(#PB_2DDrawing_Default)
For Y = 0 To BoxHeight
Line(BoxWidth+1, Y, #ColorGadget_ChannelSize, 1, ColorGadget_SetHSVA(Y*360.0/BoxHeight, HSVA\Saturation, HSVA\Value))
Next
For X = 0 To BoxWidth+#ColorGadget_ChannelSize Step 6
For Y = 0 To #ColorGadget_ChannelSize-1 Step 6
If X%12 XOr Y%12
Box(X, BoxHeight+1+Y, 6, 6, $A0A0A0)
Else
Box(X, BoxHeight+1+Y, 6, 6, $606060)
EndIf
Next
Next
DrawingMode(#PB_2DDrawing_AlphaBlend)
For X = 0 To BoxWidth
Alpha = X*255.0/BoxWidth
Line(X, BoxHeight+1, 1, #ColorGadget_ChannelSize, Color&$FFFFFF|Alpha<<24)
Next
DrawingMode(#PB_2DDrawing_XOr)
Box(BoxWidth+1, BoxHeight*HSVA\Hue/360-1, #ColorGadget_ChannelSize, 3)
Box(HSVA\Alpha*BoxWidth/255-1, BoxHeight+1, 3, #ColorGadget_ChannelSize)
DrawingMode(#PB_2DDrawing_AlphaBlend)
Box(BoxWidth+1, BoxHeight+1, #ColorGadget_ChannelSize, #ColorGadget_ChannelSize, Color)
StopDrawing()
EndIf
SetGadgetData(Gadget, Color)
EndProcedure
Procedure ColorGadget(Gadget.i, X.i, Y.i, Width.i, Height.i, DefaultColor.l=$FF000000)
If Gadget = #PB_Any
Gadget = CanvasGadget(Gadget, X, Y, Width, Height);, #PB_Canvas_GrabMouse)
Else
CanvasGadget(Gadget, X, Y, Width, Height);, #PB_Canvas_GrabMouse)
EndIf
DrawColorGadget(Gadget, DefaultColor)
EndProcedure
Procedure ColorGadgetEvent(Gadget.i, EventType.i)
Static Mode.i = #Null
Protected X.i = GetGadgetAttribute(Gadget, #PB_Canvas_MouseX)
Protected Y.i = GetGadgetAttribute(Gadget, #PB_Canvas_MouseY)
Protected BoxWidth.i = GadgetWidth(Gadget)-#ColorGadget_ChannelSize-1
Protected BoxHeight.i = GadgetHeight(Gadget)-#ColorGadget_ChannelSize-1
Protected Color = GetGadgetData(Gadget)
Protected HSVA.ColorGadget_HSVA
ColorGadget_GetHVSA(Color, @HSVA)
Select EventType
Case #PB_EventType_LeftButtonDown
If X <= BoxWidth And Y <= BoxHeight
Mode = 1
ElseIf X > BoxWidth And Y <= BoxHeight
Mode = 2
ElseIf Y > BoxHeight And X <= BoxWidth
Mode = 3
EndIf
Case #PB_EventType_LeftButtonUp
Mode = #Null
Case #PB_EventType_MouseMove
EndSelect
Select Mode
Case 1
SetGadgetAttribute(Gadget, #PB_Canvas_Cursor, #PB_Cursor_Arrows)
Case 2
SetGadgetAttribute(Gadget, #PB_Canvas_Cursor, #PB_Cursor_UpDown)
Case 3
SetGadgetAttribute(Gadget, #PB_Canvas_Cursor, #PB_Cursor_LeftRight)
Default
SetGadgetAttribute(Gadget, #PB_Canvas_Cursor, #PB_Cursor_Default)
EndSelect
If Mode
Select EventType
Case #PB_EventType_MouseMove, #PB_EventType_LeftButtonDown
Select Mode
Case 1
HSVA\Saturation = Y/BoxHeight
HSVA\Value = 255.0 * X/BoxWidth
Case 2
HSVA\Hue = 360.0 * Y/BoxHeight
Case 3
HSVA\Alpha = 255.0 * X/BoxWidth
EndSelect
DrawColorGadget(Gadget, ColorGadget_SetHSVA(HSVA\Hue, HSVA\Saturation, HSVA\Value, HSVA\Alpha))
ProcedureReturn #True
EndSelect
EndIf
EndProcedure
Procedure GetColorGadgetColor(Gadget.i)
ProcedureReturn GetGadgetData(Gadget)
EndProcedure
Procedure SetColorGadgetColor(Gadget.i, Color.l)
DrawColorGadget(Gadget, Color)
EndProcedure
;- Beispiel
Enumeration
#Window
#ColorGadget
EndEnumeration
OpenWindow(#Window, 0, 0, 300, 300, "ColorGadget", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
ColorGadget(#ColorGadget, 10, 10, 280, 280, $C050F0A0)
Repeat
Define.i Event = WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
Select EventGadget()
Case #ColorGadget
ColorGadgetEvent(#ColorGadget, EventType())
EndSelect
EndSelect
ForEver