Code: Alles auswählen
; HJBremer V2.01/2023"
;- Declare
DeclareModule ColorMaker
Declare.i ColorMaker(pbnr, x, y, w=360) ;gibt pbnr oder ID vom Container zurück
Declare.i GetColorMaker() ;gibt die eingestellte Farbe zurück
Declare.i SetColorMaker(color) ;Farbe einstellen
Macro MakeHexColor(value, size=6) ;für Farben reichen 6 Stellen,
"$" + RSet(Hex(value), size, "0") ;Hinweis: -1 ergibt $FFFFFF, aber $FFFFFF ist nicht -1
EndMacro
EndDeclareModule
;- Module
Module ColorMaker
EnableExplicit
Structure colormaker
container.i ;pbnr vom Container = Nr für Abfrage der Farbe
r.a ;einzelne Farbwerte die mit den TrackbarGadgets verändert werden
g.a
b.a
rgbColor.i ;Summe der einzelnen Farbwerte
value.i[4] ;0-3, pbnr der CanvasGadgets für Anzeige der Farbwerte, benutzt wird 1-3
track.i[4] ;0-3, pbnr der TrackbarGadgets für ändern der Farbwerte, benutzt wird 1-3
rgbhex.i ;pbnr des CanvasGadgets für Anzeige des RGB Wertes als HexString
rgbinfo.i ;pbnr des CanvasGadgets für Anzeige der Farbe (Backcolor)
colorliste.i ;pbnr des Comboboxgadgets für Farbliste
gradientGadget.i ;pbnr des CanvasGadgets für Farbverlauf
EndStructure
Global cm.colormaker
Global canvasfont = FontID(LoadFont(#PB_Any, "Consolas", 11))
Global pbcolor$, pbwerte$ ;für ColorListe in Combobox
pbcolor$ = "Farben ,Red ,Green ,Blue ,Cyan ,Yellow ,Magenta,Gray ,White ,Black ,Creme ,Orange ,Brown ,DkGreen"
pbwerte$ = "$F0F0F0,$0000FF,$00FF00,$FF0000,$FFFF00,$00FFFF,$FF00FF,$808080,$FFFFFF,$000000,$CFFFFF,$0080FF,$000080,$008000"
#rColor = #Red: #gColor = $6600: #bColor = #Blue: #canvasBackcolor = $F0F0F0: #canvasEnterColor = $FFECDD
Procedure.i GradientGadget(pbnr, x, y, w, h, flag=0)
Protected nr = CanvasGadget(pbnr, x, y, w, h)
If pbnr = #PB_Any : pbnr = nr : EndIf
StartDrawing(CanvasOutput(pbnr))
Box(0, 0, w, h, #Black) ;Rahmen
Box(1, 1, w-2, h-2, #White) ;Rahmen
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(#Black)
GradientColor(0.10, $000080) ;Brown
GradientColor(0.20, #Blue)
GradientColor(0.30, #Cyan)
GradientColor(0.40, #Green)
GradientColor(0.50, #Yellow)
GradientColor(0.60, $0080FF) ;Orange
GradientColor(0.70, #Red)
GradientColor(0.80, #Magenta)
GradientColor(0.90, #Gray)
GradientColor(0.95, $CFFFFF) ;Creme
FrontColor(#White)
LinearGradient(0, w, w, w)
If flag: LinearGradient(h, 0, h, h): EndIf ;für senkrechte Darstellung (Parameter w+h anpassen)
Box(2, 2, w-4,h-4)
StopDrawing()
ProcedureReturn pbnr
EndProcedure
Procedure.i GetGradientColor(pbnr) ;gibt Farbe zurück wenn GradientGadget angeclickt
Protected x, y, color
x = GetGadgetAttribute(pbnr, #PB_Canvas_MouseX)
y = GetGadgetAttribute(pbnr, #PB_Canvas_MouseY)
StartDrawing(CanvasOutput(pbnr))
color = Point(x,y)
StopDrawing()
ProcedureReturn color
EndProcedure
Procedure.i SetCanvasInfo(pbnr, color) ;aktualisiert AnzeigeFarbe
StartDrawing(CanvasOutput(pbnr))
Box(0, 0, GadgetWidth(pbnr), GadgetHeight(pbnr), color)
StopDrawing()
EndProcedure
Procedure.i SetCanvasText(pbnr, value, fcolor, bcolor=0) ;aktualisiert RGB-Gadgets
Protected text$, x, w = GadgetWidth(pbnr), h = GadgetHeight(pbnr)
Protected backcolor = #canvasbackcolor
If bcolor: backcolor = #canvasEnterColor: EndIf
StartDrawing(CanvasOutput(pbnr))
Box(0, 0, w, h, #Gray) ;Rahmen
Box(1, 1, w-2, h-2, backcolor) ;
DrawingFont(canvasfont)
If fcolor ;true wenn rot grün oder blau CanvasGadget
text$ = MakeHexColor(value, 2) + "/" + RSet(Str(value), 3, "0")
Else
text$ = MakeHexColor(value) ;für RGB CanvasGadget
EndIf
x = (w - TextWidth(text$)) / 2
DrawText(x, 2, text$, fcolor, backcolor)
StopDrawing()
EndProcedure
Procedure.i GetColorMaker() ;gibt Farbwert zurück
ProcedureReturn cm\rgbColor
EndProcedure
Procedure.i SetColorMaker(color) ;setzt Farbwert
With cm
\r = Red(color): \g = Green(color): \b = Blue(color): \rgbColor = color
SetGadgetState(\track[1], \r) : SetCanvasText(\value[1], \r, #rColor) ;Red
SetGadgetState(\track[2], \g) : SetCanvasText(\value[2], \g, #gColor) ;Green
SetGadgetState(\track[3], \b) : SetCanvasText(\value[3], \b, #bColor) ;Blue
SetCanvasText(\rgbhex, color, #Black)
SetCanvasInfo(\rgbinfo, color)
PostEvent(#PB_Event_Gadget , EventWindow() , \rgbinfo , #PB_EventType_Change, color)
EndWith
EndProcedure
Procedure.i ColorMakerEvent()
With cm
Static oldcolor, bcolor1, bcolor2, bcolor3
Protected x, y, add, item, color, window = EventWindow()
Select EventGadget()
Case \track[1], \track[2], \track[3] : ;TrackBarGadgets werden benutzt
Select EventGadget()
Case \track[1] : \r = GetGadgetState(\track[1]) : SetCanvasText(\value[1], \r, #rColor)
Case \track[2] : \g = GetGadgetState(\track[2]) : SetCanvasText(\value[2], \g, #gColor)
Case \track[3] : \b = GetGadgetState(\track[3]) : SetCanvasText(\value[3], \b, #bColor)
EndSelect
\rgbColor = RGB(\r,\g,\b)
If \rgbColor <> oldcolor : oldcolor = \rgbColor ;wenn Farbe sich ändert
SetCanvasText(\rgbhex, \rgbColor, #Black) ;RGB Info
SetCanvasInfo(\rgbinfo, \rgbColor) ;Farbinfofeld
PostEvent(#PB_Event_Gadget , window , \container , #PB_EventType_Change, \rgbColor)
EndIf
Case \value[1], \value[2], \value[3] : ;Value CanvasGadgets werden benutzt
Select EventGadget()
Case \value[1]
Select EventType()
Case #PB_EventType_MouseEnter: bcolor1 = 1
Case #PB_EventType_MouseLeave: bcolor1 = 0
Case #PB_EventType_LeftButtonDown: add = -16
Case #PB_EventType_RightButtonDown: add = 16
Default: ProcedureReturn
EndSelect
Case \value[2]
Select EventType()
Case #PB_EventType_MouseEnter: bcolor2 = 1
Case #PB_EventType_MouseLeave: bcolor2 = 0
Case #PB_EventType_LeftButtonDown: add = -8
Case #PB_EventType_RightButtonDown: add = 8
Default: ProcedureReturn
EndSelect
Case \value[3]
Select EventType()
Case #PB_EventType_MouseEnter: bcolor3 = 1
Case #PB_EventType_MouseLeave: bcolor3 = 0
Case #PB_EventType_LeftButtonDown: add = -4
Case #PB_EventType_RightButtonDown: add = 4
Default: ProcedureReturn
EndSelect
EndSelect
\r + add: SetGadgetState(\track[1], \r) : SetCanvasText(\value[1], \r, #rColor, bcolor1)
\g + add: SetGadgetState(\track[2], \g) : SetCanvasText(\value[2], \g, #gColor, bcolor2)
\b + add: SetGadgetState(\track[3], \b) : SetCanvasText(\value[3], \b, #bColor, bcolor3)
\rgbColor = RGB(\r,\g,\b)
If \rgbColor <> oldcolor : oldcolor = \rgbColor ;wenn Farbe sich ändert
SetCanvasText(\rgbhex, \rgbColor, #Black) ;RGB Info
SetCanvasInfo(\rgbinfo, \rgbColor) ;Farbinfofeld
PostEvent(#PB_Event_Gadget , window , \container , #PB_EventType_Change, \rgbColor)
EndIf
Case \rgbhex: ;zeigt RGB-Color als Hexwert
Select EventType()
Case #PB_EventType_MouseEnter: SetCanvasText(\rgbhex, \rgbColor, #Black, 1)
Case #PB_EventType_MouseLeave: SetCanvasText(\rgbhex, \rgbColor, #Black, 0)
Case #PB_EventType_LeftButtonDown: SetClipboardText(MakeHexColor(\rgbColor))
EndSelect
Case \rgbinfo:
If EventType() = #PB_EventType_LeftButtonDown
Debug "Future: z.B. Speichern"
EndIf
Case \colorliste: ;Combobox mit Farben
item = GetGadgetState(\colorliste) + 1
color = Val(StringField(pbwerte$, item, ","))
SetColorMaker(color)
PostEvent(#PB_Event_Gadget , window , \container , #PB_EventType_Change, color)
Case \gradientGadget: ;FarbverlaufGadget
If EventType() = #PB_EventType_LeftClick
color = GetGradientColor(\gradientGadget)
SetColorMaker(color)
PostEvent(#PB_Event_Gadget , window , \container , #PB_EventType_Change, color)
EndIf
EndSelect
EndWith
EndProcedure
Procedure.i ColorMaker(pbnr, x, y, w=360)
If w < 200: w = 200: EndIf
Protected nr, j, xx = 6, yy = 15, ww = 72, hh = 22, tx = xx+ww+6, tw = w - 92
With cm
nr = ContainerGadget(pbnr, x, y, w, 0, #PB_Container_Flat)
\container = pbnr: If pbnr = #PB_Any: pbnr = nr : \container = pbnr: EndIf
\value[1] = CanvasGadget(#PB_Any, xx, yy, ww, hh)
\track[1] = TrackBarGadget(#PB_Any, tx, yy, tw, hh, 0, 255) : yy+hh+5
\value[2] = CanvasGadget(#PB_Any, xx, yy, ww, hh)
\track[2] = TrackBarGadget(#PB_Any, tx, yy, tw, hh, 0, 255) : yy+hh+5
\value[3] = CanvasGadget(#PB_Any, xx, yy, ww, hh)
\track[3] = TrackBarGadget(#PB_Any, tx, yy, tw, hh, 0, 255) : yy+hh+10
\rgbhex = CanvasGadget(#PB_Any, xx, yy, ww, hh) : GadgetToolTip(\rgbhex, "to Clipboard")
\rgbinfo = CanvasGadget(#PB_Any, tx, yy, tw, hh, #PB_Canvas_Border) : yy+hh+10
\colorliste = ComboBoxGadget(#PB_Any, xx, yy, ww, hh, #LBS_MULTICOLUMN)
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
SendMessage_(GadgetID(\colorliste), #CB_SETMINVISIBLE, 8, 0)
;SendMessage_(GadgetID(\colorliste), #CB_SETDROPPEDWIDTH, ww + 18, #Null)
CompilerEndIf
For j = 1 To 14
AddGadgetItem(\colorliste, -1, StringField(pbcolor$, j, ","))
Next
SetGadgetState(\colorliste, 0)
\gradientGadget = GradientGadget(#PB_Any, xx+ww+5, yy, tw, hh)
ResizeGadget(\container, x, y, w, GadgetY(\gradientGadget)+hh+15)
BindEvent(#PB_Event_Gadget, @ColorMakerEvent())
SetColorMaker(#White) ;Startfarbe um Gadgets mit Werten zu füllen
CloseGadgetList()
EndWith
ProcedureReturn nr
EndProcedure
EndModule
UseModule ColorMaker
CompilerIf #PB_Compiler_IsMainFile
Enumeration 100
#win
#colormaker
#optBack: #optFront: #text
EndEnumeration
Define backcolor = $DFFFFF, frontcolor = #Blue
OpenWindow(#win, 0, 0, 400, 300, "ColorMaker", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ColorMaker(#colormaker, 20, 20)
SetColorMaker(backcolor)
Define y = GadgetHeight(#colormaker) + 40
OptionGadget(#optBack, 20, y, 80, 22, "BackColor")
OptionGadget(#optFront, 100, y, 80, 22, "FrontColor") : y + 40
SetGadgetState(#optBack, 1)
TextGadget(#text, 20, y, 200, 30, " dies ist ein Test !", #PB_Text_Border)
SetGadgetColor(#text, #PB_Gadget_BackColor, backcolor)
SetGadgetColor(#text, #PB_Gadget_FrontColor, frontcolor)
Repeat :
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #colormaker
color = GetColormaker() ;oder EventData()
If GetGadgetState(#optBack)
backcolor = color: SetGadgetColor(#text, #PB_Gadget_BackColor, color)
Else
frontcolor = color: SetGadgetColor(#text, #PB_Gadget_FrontColor, color)
EndIf
Case #optBack: SetColorMaker(backcolor)
Case #optFront: SetColorMaker(frontcolor)
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
CompilerEndIf