PureBoard

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