PureBasic Forums - English

Posted: **Sun Mar 26, 2006 8:15 pm**

Code updated for 5.20+

I will not win a nobel price with this one ...

I hope it can be useful for someone

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Color Preview Gadget
; File Version : 1.0.0
; Programmation : OK
; Programmed by : Guimauve
; Date : 26-03-2006
; Last Update : 26-03-2006
; Coded for PureBasic V4.00
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure ColorPreviewGadget(GadgetID, x, y, Width, Height, Color)
   
   CreateImage(GadgetID, Width, Height)
   
   If StartDrawing(ImageOutput(GadgetID))
      
      Box(0, 0, Width, Height, Color)
      DrawingMode(#PB_2DDrawing_Outlined)
      Box(0, 0, Width, Height, 0)
      
      StopDrawing()
      
   EndIf 
   
   ImageGadget(GadgetID, x, y, Width, Height, ImageID(GadgetID))
   
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure SetCurrentColorPreviewGadget(GadgetID, Color)
   
   CreateImage(GadgetID, GadgetWidth(GadgetID), GadgetHeight(GadgetID))
   
   If StartDrawing(ImageOutput(GadgetID))
      
      Box(0, 0, GadgetWidth(GadgetID), GadgetHeight(GadgetID), Color)
      DrawingMode(#PB_2DDrawing_Outlined)
      Box(0, 0, GadgetWidth(GadgetID), GadgetHeight(GadgetID), 0)
      
      StopDrawing() 
      
   EndIf 
   
   SetGadgetState(GadgetID, ImageID(GadgetID))
   
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure GetCurrentColorPreviewGadget(GadgetID)
   
   If StartDrawing(ImageOutput(GadgetID))
      CurrentColor.l = Point(GadgetWidth(GadgetID) >> 1, GadgetHeight(GadgetID) >> 1)
      StopDrawing()
   EndIf 
   
   ProcedureReturn CurrentColor
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure AskUserForNewColor(GadgetID)
   
   Color.l = ColorRequester()
   
   If Color > -1
      
      SetCurrentColorPreviewGadget(GadgetID, Color)
      
   EndIf
   
   
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Enumeration
   
   #Main_Win
   
   #ColorPreview_One
   #ColorPreview_Two
   #ColorPreview_Three
   #ColorPreview_Four
   
   #Btn_ColorPreview_One
   #Btn_ColorPreview_Two
   #Btn_ColorPreview_Three
   #Btn_ColorPreview_Four 
   #Btn_MSGREQUESTER
   
EndEnumeration 

Procedure MainWindow()
   
   If OpenWindow(#Main_Win, 75,75, 300, 150,"Demo ColorPreviewGadget") <> 0
      
     ColorPreviewGadget(#ColorPreview_One,5,5,60,20,RGB(000,000,255))
     ColorPreviewGadget(#ColorPreview_Two,5,30,60,20,RGB(255,000,000))
     ColorPreviewGadget(#ColorPreview_Three,5,55,60,20, RGB(255,255,000))
     ColorPreviewGadget(#ColorPreview_Four,5,85,60,20,RGB(128,000,255))
     
     ButtonGadget(#Btn_ColorPreview_One,75,5,60,20,"...")
     ButtonGadget(#Btn_ColorPreview_Two,75,30,60,20, "...")
     ButtonGadget(#Btn_ColorPreview_Three,75,55,60,20, "...")
     ButtonGadget(#Btn_ColorPreview_Four,75,85,60,20,"...")
     
     ButtonGadget(#Btn_MSGREQUESTER,5,110,100,25,"GetColor")
      
   EndIf
   
EndProcedure 

Procedure EventManager()
   
   MainWindow()
   
   Repeat
      
      EventID = WindowEvent()
      
      Select EventID
         
         Case #PB_Event_Gadget
            
            Select EventGadget()
               
               Case #Btn_ColorPreview_One
                  AskUserForNewColor(#ColorPreview_One)
                  
               Case #Btn_ColorPreview_Two
                  AskUserForNewColor(#ColorPreview_Two)
                  
               Case #Btn_ColorPreview_Three
                  AskUserForNewColor(#ColorPreview_Three)
                  
               Case #Btn_ColorPreview_Four 
                  AskUserForNewColor(#ColorPreview_Four)
                  
               Case #Btn_MSGREQUESTER 
                  For Index = #ColorPreview_One To #ColorPreview_Four
                     MessageRequester("Test", "The color number for the " + Str(Index)+ " ColorPreviewGadget is : " + Str(GetCurrentColorPreviewGadget(Index)))
                  Next 
                  
            EndSelect
            
      EndSelect
      
   Until EventID = #PB_Event_CloseWindow
   
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

EventManager()

Regards
Guimauve

Posted: **Sun Mar 26, 2006 10:16 pm**

it is even easier with the commands of PB4, setgadgetcolor and TextGadget to post a color.

Posted: **Sun Mar 26, 2006 11:04 pm**

Nico wrote:it is even easier with the commands of PB4, setgadgetcolor and TextGadget to post a color.

It's an old code I have created for PB 3.81 or something. Anyway this code still working but I agree with you the new command can do the same thing.

Regards
Guimauve

Posted: **Wed Mar 29, 2006 12:36 am**

Regardless of PB's current capabilities - it is interesting code.

The "drawing" will help me with a "button" issue I'm working on.

thanks for sharing it.

cheers

Posted: **Tue Mar 26, 2019 8:30 pm**

Hello everyone,

Sorry to re-open an old topic but there is an update I made of Guimauve's original code.

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : ColorPreview Gadget
; File Name : ColorPreview Gadget - Module.pb
; File version: 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : 17-03-2019
; Last Update : 26-03-2019
; PureBasic code : V5.70 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programing notes
;
; Rougthly based on Guimauve's original code, see here : 
; https://www.purebasic.fr/english/viewtopic.php?f=12&t=20749
;
; I deserve credit for the Module conversion.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule ColorPreview
  
  Declare.l CurrentColor(GadgetID, Color.l = -1)
  Declare Gadget(GadgetID, x.w, y.w, Width.w, Height.w, Color.l)
  Declare Free(GadgetID)
  
EndDeclareModule

Module ColorPreview
  
  Procedure.l CurrentColor(GadgetID, Color.l = -1)
    
    If IsGadget(GadgetID) And GadgetType(GadgetID) = #PB_GadgetType_Image
      
      If Color <> -1
        
        If GetGadgetData(GadgetID) <> #Null
          
          Width = GadgetWidth(GadgetID)
          Height = GadgetHeight(GadgetID)
          
          If StartDrawing(ImageOutput(GetGadgetData(GadgetID)))
            Box(0, 0, Width, Height, Color)
            StopDrawing()
            SetGadgetState(GadgetID, ImageID(GetGadgetData(GadgetID)))
          EndIf 
          
        EndIf
        
      Else
        
        If GetGadgetData(GadgetID) <> #Null
          
          PosX = GadgetWidth(GadgetID) >> 1
          PosY = GadgetHeight(GadgetID) >> 1
          
          If StartDrawing(ImageOutput(GetGadgetData(GadgetID)))
            CurrentColor = Point(PosX, PosY)
            StopDrawing()
          EndIf 
          
        EndIf

        ProcedureReturn CurrentColor
        
      EndIf
      
    EndIf  
    
  EndProcedure 
  
  Procedure Gadget(GadgetID, x.w, y.w, Width.w, Height.w, Color.l)
    
    GadgetHandle = ImageGadget(GadgetID, x, y, Width, Height, 0, #PB_Image_Border)
    
    If GadgetID = #PB_Any 
      GadgetID = GadgetHandle 
    EndIf 
    
    SetGadgetData(GadgetID, CreateImage(#PB_Any, Width, Height))
    CurrentColor(GadgetID, Color)
    
    ProcedureReturn GadgetID
  EndProcedure 
  
  Procedure Free(GadgetID)
    
    If IsGadget(GadgetID) And GadgetType(GadgetID) = #PB_GadgetType_Image
      If GetGadgetData(GadgetID) <> #Null
        FreeImage(GetGadgetData(GadgetID))
      EndIf
    EndIf
    
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
 
  If OpenWindow(0, 0, 0, 245, 105, "ColorPreview::Gadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   
    TextGadget(0, 5,5,80,34, "My color 0 :")
    ColorPreview::Gadget(1, 85, 5, 75, 34, RGB(255, 255, 000))
   
    TextGadget(2, 5,45,80,34, "My color 1 :")
    ColorPreview::Gadget(3, 85, 45, 75, 34, RGB(255,000, 255))
   
    GadgetToolTip(1, "Click me")
    GadgetToolTip(3, "Click me")
   
    Repeat
     
      Select WaitWindowEvent()
         
        Case #PB_Event_Gadget
         
          Select EventGadget()
             
            Case 1
              If EventType() = #PB_EventType_LeftClick
                NewColor.l = ColorRequester(ColorPreview::CurrentColor(1, -1))
               
                If NewColor <> -1
                  ColorPreview::CurrentColor(1, NewColor)
                EndIf
              EndIf
             
            Case 3
              If EventType() = #PB_EventType_LeftClick
                NewColor.l = ColorRequester(ColorPreview::CurrentColor(3, -1))
               
                If NewColor <> -1
                  ColorPreview::CurrentColor(3, NewColor)
                EndIf
              EndIf
             
          EndSelect
         
        Case #PB_Event_CloseWindow
         
          Select EventWindow()
             
            Case 0
              ColorPreview::Free(1)
              ColorPreview::Free(3)
              CloseWindow(0)
              Break
             
          EndSelect
         
      EndSelect
     
    ForEver
   
    End
  EndIf
 
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: **Tue Mar 26, 2019 8:59 pm**

Looks good, thank you

But I think that I've found a mistake:
If I've selected a color or have opened the ColorRequester for any other purpose before, then the next move of the mouse cursor over the color preview area already causes the next call of the ColorRequester (which should only happen on a real mouse-click I think!?)

Posted: **Tue Mar 26, 2019 10:06 pm**

Andre wrote:Looks good, thank you

But I think that I've found a mistake:
If I've selected a color or have opened the ColorRequester for any other purpose before, then the next move of the mouse cursor over the color preview area already causes the next call of the ColorRequester (which should only happen on a real mouse-click I think!?)

I have tested this only on Linux and everything work fine. That being said the testing code to avoid that should look like this :

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
 
  If OpenWindow(0, 0, 0, 245, 105, "ColorPreview::Gadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   
    TextGadget(0, 5,5,80,34, "My color 0 :")
    ColorPreview::Gadget(1, 85, 5, 75, 34, RGB(255, 255, 000))
   
    TextGadget(2, 5,45,80,34, "My color 1 :")
    ColorPreview::Gadget(3, 85, 45, 75, 34, RGB(255,000, 255))
   
    GadgetToolTip(1, "Click me")
    GadgetToolTip(3, "Click me")
   
    Repeat
     
      Select WaitWindowEvent()
         
        Case #PB_Event_Gadget
          
          Select EventGadget()
              
            Case 1
              If EventType() = #PB_EventType_LeftClick
                NewColor.l = ColorRequester(ColorPreview::CurrentColor(1, -1))
                
                If NewColor <> -1
                  ColorPreview::CurrentColor(1, NewColor)
                EndIf
              EndIf
              
            Case 3
              If EventType() = #PB_EventType_LeftClick
                NewColor.l = ColorRequester(ColorPreview::CurrentColor(3, -1))
                
                If NewColor <> -1
                  ColorPreview::CurrentColor(3, NewColor)
                EndIf
              EndIf
              
          EndSelect
          
        Case #PB_Event_CloseWindow
         
          Select EventWindow()
             
            Case 0
              ColorPreview::Free(1)
              ColorPreview::Free(3)
              CloseWindow(0)
              Break
             
          EndSelect
         
      EndSelect
     
    ForEver
   
    End
  EndIf
 
CompilerEndIf

Best regards
StarBootics

Posted: **Tue Mar 26, 2019 10:13 pm**

StarBootics wrote:I have tested this only on Linux and everything work fine. That being said the testing code to avoid that should look like this :

Yes, this works here (Win10). Thank you!

So it seems that Windows does need this additional "filter" to avoid unwanted behaviour...

Posted: **Wed Mar 27, 2019 4:49 pm**

Nice for a start, but more helpful if:
The colors are printed to a text box(not MessageRequester()):
RGB(r,g,b)
Long
Hex
RGBA(r,g,b,a)

And:
The mouse can hover over any window and get the color directly under.

Posted: **Thu Mar 28, 2019 1:17 am**

skywalk wrote:Nice for a start, but more helpful if:
The colors are printed to a text box(not MessageRequester()):
RGB(r,g,b)
Long
Hex
RGBA(r,g,b,a)

And:
The mouse can hover over any window and get the color directly under.

Guimauve's original code was meant to be used with a ColorRequester() and this is exactly what I need. But since an ImageGadget() can handle event there is no need to have a button to launch a ColorRequester(), that was the tricks I want to share with this example. What you are suggesting can be useful but I'm not going to do it, sorry.

Best regards
StarBootics

Posted: **Mon May 25, 2020 2:47 pm**

Hello everyone,

I have an update on the ColorPreview Gadget. I have added the RGBA colors support to it. The gadget will show a a checker background if the color is fully transparent. For partially transparent color, the color will appear over the checkered background to appreciate the transparency.

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : ColorPreview Gadget
; File Name : ColorPreview Gadget - Module.pb
; File version: 2.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : 09-03-2015
; Last Update : 25-05-2020
; PureBasic code : V5.72 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programing notes
;
; Rougthly based on Guimauve's original code, see here : 
; https://www.purebasic.fr/english/viewtopic.php?f=12&t=20749
;
; I deserve credit for the Module conversion.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule ColorPreview
  
  Declare.q CurrentColor(GadgetID, Color.q = -1)
  Declare Gadget(GadgetID, x.w, y.w, Width.w, Height.w, Color.q, SupportRGBA.a = 0)
  Declare Free(GadgetID)
  
EndDeclareModule

Module ColorPreview
  
  Structure Instance
    
    SupportRGBA.a
    CurrentColor.q
    BackgroundID.i
    ImageID.i
    
  EndStructure
  
  Procedure.q CurrentColor(GadgetID, Color.q = -1)
    
    If IsGadget(GadgetID)
      
      If Color <> -1
        
        *Instance.Instance = GetGadgetData(GadgetID)
        
        If *Instance <> #Null
          
          *Instance\CurrentColor = Color & $FFFFFFFF
          Width = GadgetWidth(GadgetID)
          Height = GadgetHeight(GadgetID)
          
          If *Instance\SupportRGBA <> 0
            ColorImage.i = CreateImage(#PB_Any, Width, Height, 32)
          Else
            ColorImage.i = CreateImage(#PB_Any, Width, Height, 24)
          EndIf
          
          If StartDrawing(ImageOutput(ColorImage))
            
            DrawingMode(#PB_2DDrawing_AllChannels)
            Box(0, 0, Width, Height, *Instance\CurrentColor)
            StopDrawing()
            
          EndIf
          
          If StartDrawing(ImageOutput(*Instance\ImageID))
            
            If *Instance\SupportRGBA <> 0
              DrawImage(ImageID(*Instance\BackgroundID), 0, 0)
              DrawAlphaImage(ImageID(ColorImage), 0, 0)
            Else
              DrawImage(ImageID(ColorImage), 0, 0)
            EndIf
            
            StopDrawing()
            
            SetGadgetState(GadgetID, ImageID(*Instance\ImageID))
            FreeImage(ColorImage)
            
          EndIf 
          
        EndIf
        
      Else
        
        *Instance.Instance = GetGadgetData(GadgetID)
        
        If *Instance <> #Null
          
          CurrentColor.q = *Instance\CurrentColor & $FFFFFFFF
          
        EndIf
        
        ProcedureReturn CurrentColor
        
      EndIf
      
    EndIf  
    
  EndProcedure 
  
  Procedure Gadget(GadgetID, x.w, y.w, Width.w, Height.w, Color.q, SupportRGBA.a = 0)
    
    GadgetHandle = ImageGadget(GadgetID, x, y, Width, Height, 0, #PB_Image_Border)
    
    If GadgetID = #PB_Any 
      GadgetID = GadgetHandle 
    EndIf 
    
    *Instance.Instance = AllocateStructure(Instance)
    
    *Instance\SupportRGBA = SupportRGBA
    
    If *Instance\SupportRGBA = 0
      *Instance\ImageID = CreateImage(#PB_Any, Width, Height)
    Else
      
      *Instance\BackgroundID = CreateImage(#PB_Any, Width, Height, 24)
      *Instance\ImageID = CreateImage(#PB_Any, Width, Height, 32)
      
      If StartDrawing(ImageOutput(*Instance\BackgroundID))
        
        Color1.q = RGB(000,000,000)
        Color2.q = RGB(128,128,128)
        
        For PosY = 0 To Height - 1 Step 8
          
          For PosX = 0 To Width - 1 Step 8
            
            Box(PosX, PosY, 8, 8, Color1)
            
            Swap Color1, Color2
            
          Next 
          
          Swap Color1, Color2
          
        Next
        
        StopDrawing()
        
      EndIf
      
    EndIf
    
    SetGadgetData(GadgetID, *Instance)
    CurrentColor(GadgetID, Color)
    
    ProcedureReturn GadgetID
  EndProcedure 
  
  Procedure Free(GadgetID)
    
    If IsGadget(GadgetID)
      
      *Instance.Instance = GetGadgetData(GadgetID)
      
      If *Instance <> #Null
        
        If IsImage(*Instance\BackgroundID)
          FreeImage(*Instance\BackgroundID)
        EndIf
        
        FreeImage(*Instance\ImageID)
        FreeStructure(*Instance)
        
      EndIf
      
    EndIf
    
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  If OpenWindow(0, 0, 0, 245, 150, "ColorPreview::Gadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
    TextGadget(0, 5, 5, 80, 34, "My color 0 :")
    ColorPreview::Gadget(1, 85, 5, 75, 34, RGB(255, 255, 000))
    
    TextGadget(2, 5, 45, 80, 34, "My color 1 :")
    ColorPreview::Gadget(3, 85, 45, 75, 34, RGB(255,000, 255))
    
    TextGadget(4, 5, 85, 80, 34, "My color 2 :")
    ColorPreview::Gadget(5, 85, 85, 75, 34, RGBA(255, 000, 255, 128), #True)
    
    GadgetToolTip(1, "Click me")
    GadgetToolTip(3, "Click me")
    
    Repeat
      
      Select WaitWindowEvent()
          
        Case #PB_Event_Gadget
          
          Select EventGadget()
             
            Case 1
              If EventType() = #PB_EventType_LeftClick
                NewColor.l = ColorRequester(ColorPreview::CurrentColor(1, -1))
               
                If NewColor <> -1
                  ColorPreview::CurrentColor(1, NewColor)
                EndIf
              EndIf
             
            Case 3
              If EventType() = #PB_EventType_LeftClick
                NewColor.l = ColorRequester(ColorPreview::CurrentColor(3, -1))
               
                If NewColor <> -1
                  ColorPreview::CurrentColor(3, NewColor)
                EndIf
              EndIf
             
          EndSelect
          
        Case #PB_Event_CloseWindow
          
          Select EventWindow()
              
            Case 0
              ColorPreview::Free(1)
              ColorPreview::Free(3)
              ColorPreview::Free(5)
              CloseWindow(0)
              Break
              
          EndSelect
          
      EndSelect
      
    ForEver
    
    End
  EndIf
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Best regards
StarBootics

PureBasic Forums - English

ColorPreviewGadget

ColorPreviewGadget

Re: ColorPreviewGadget

Re: ColorPreviewGadget

Re: ColorPreviewGadget

Re: ColorPreviewGadget

Re: ColorPreviewGadget

Re: ColorPreviewGadget

Re: ColorPreviewGadget