It is currently Tue Dec 10, 2019 8:07 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 10 posts ] 
Author Message
 Post subject: ColorPreviewGadget
PostPosted: Sun Mar 26, 2006 8:15 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Oct 22, 2003 2:51 am
Posts: 743
Location: Canada
Code updated for 5.20+

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

I hope it can be useful for someone

Code:
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Mar 26, 2006 10:16 pm 
Offline
Enthusiast
Enthusiast

Joined: Sun Jan 11, 2004 11:34 am
Posts: 274
Location: France
it is even easier with the commands of PB4, setgadgetcolor and TextGadget to post a color.


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Mar 26, 2006 11:04 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Oct 22, 2003 2:51 am
Posts: 743
Location: Canada
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


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Wed Mar 29, 2006 12:36 am 
Offline
Addict
Addict

Joined: Wed Aug 24, 2005 8:39 am
Posts: 2736
Location: Southwest OH - USA
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


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPreviewGadget
PostPosted: Tue Mar 26, 2019 8:30 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jul 07, 2013 11:35 am
Posts: 448
Location: Canada
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:
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

_________________
The Stone Age did not end due to a shortage of stones !


Last edited by StarBootics on Tue Mar 26, 2019 10:08 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPreviewGadget
PostPosted: Tue Mar 26, 2019 8:59 pm 
Offline
PureBasic Team
PureBasic Team
User avatar

Joined: Fri Apr 25, 2003 6:14 pm
Posts: 1704
Location: Germany (Saxony, Deutscheinsiedel)
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!?)

_________________
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPreviewGadget
PostPosted: Tue Mar 26, 2019 10:06 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jul 07, 2013 11:35 am
Posts: 448
Location: Canada
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:
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

_________________
The Stone Age did not end due to a shortage of stones !


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPreviewGadget
PostPosted: Tue Mar 26, 2019 10:13 pm 
Offline
PureBasic Team
PureBasic Team
User avatar

Joined: Fri Apr 25, 2003 6:14 pm
Posts: 1704
Location: Germany (Saxony, Deutscheinsiedel)
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...

_________________
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPreviewGadget
PostPosted: Wed Mar 27, 2019 4:49 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 3149
Location: Boston, MA
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.

_________________
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum


Top
 Profile  
Reply with quote  
 Post subject: Re: ColorPreviewGadget
PostPosted: Thu Mar 28, 2019 1:17 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jul 07, 2013 11:35 am
Posts: 448
Location: Canada
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

_________________
The Stone Age did not end due to a shortage of stones !


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 10 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 12 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye