Why no SetGadgetColor for buttons?

Everything else that doesn't fall into one of the other PB categories.
User avatar
DeanH
Enthusiast
Enthusiast
Posts: 223
Joined: Wed May 07, 2008 4:57 am
Location: Adelaide, South Australia
Contact:

Re: Why no SetGadgetColor for buttons?

Post by DeanH »

I use a "clayton's button" approach. It does not involve a callback and may work on other O/s with some slight modifications. It uses a canvas control with text and set to respond. It allows for different colours, fonts and rounded corners.

Code: Select all

;{ RButton
;Create a button with rounded corners and different colours and fonts
;A normal pushbutton has an outer border colour of 240,240,240, an inner border of 173,173,173 and a background of 225,225,225, with black text
;Rounding of 2 is Chrome browser-rounded corners, 6 or 7 is fairly rounded, 4 is average
;f is a fontID value. Colours are RGB.
Procedure RBUTTON(id, text$, x, y, w=#PB_Ignore, h=#PB_Ignore, f=#PB_Ignore, txtcol=#PB_Ignore, bk=#PB_Ignore, rounding=#PB_Ignore)
	Protected bordercol, b, c, wn, tw, th, a, f
	;size
	If w=#PB_Ignore
		w=75
	EndIf
	If h=#PB_Ignore
		h=23
	EndIf
	;font
	If f=#PB_Ignore
		a=LoadFont(#PB_Any,"Tahoma",8)
		f=FontID(a)
	EndIf
	;get border colour
	bordercol=GetSysColor_(#COLOR_ACTIVEBORDER)
	;button background colour
	If bk=#PB_Ignore
		bk=RGB(225,225,225)
	EndIf
	;text colour
	If txtcol=#PB_Ignore
		txtcol=GetSysColor_(#COLOR_BTNTEXT)
	EndIf
	;rounding
	If rounding=#PB_Ignore
		rounding=0
	EndIf
	;create canvas control which acts like a button
	b=CanvasGadget(id, x, y, w, h, #PB_Canvas_Container | #PB_Canvas_Keyboard | #PB_Canvas_DrawFocus)
	If id<>#PB_Any
		b=id
	EndIf
	;window background colour
	c=RGB(240,240,240)
	wn=GetActiveWindow()
	If wn<>-1
		If IsWindow(wn)
			c=GetWindowColor(wn)
		EndIf
	EndIf
	SetGadgetColor(b,#PB_Gadget_BackColor,c)
	If c=bk
		If bk<>#White
			bk=#White
		EndIf
	EndIf
	;Draw button on canvas
	If StartDrawing(CanvasOutput(b))
		DrawingMode(#PB_2DDrawing_Outlined)
		Box(0,0,w,h,c)
		RoundBox(0,0,w,h,rounding,rounding,bordercol)
		FillArea(10,10,bordercol,bk)
		DrawingMode(#PB_2DDrawing_Transparent)
		If f<>#PB_Ignore
			DrawingFont(f)
		EndIf
		;centre text horizontally and vertically...assume single line
		tw=TextWidth(text$)
		th=TextHeight(text$)
		x=(w-tw)/2
		y=(h-th)/2
		DrawText(x,y,text$,txtcol)
		StopDrawing()
	EndIf
	CloseGadgetList()
	ProcedureReturn b
EndProcedure
;}

OpenWindow(1,#PB_Ignore,#PB_Ignore,320,240,"Test",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowColor(1, #White)
a=LoadFont(#PB_Any, "Verdana", 10)
fnt=FontID(a)
RBUTTON(10, "OK", 20, 20, 75, 23, fnt, #White, RGB(0,132,0), 4)
RBUTTON(20, "Cancel", 101, 20, 75, 23, fnt, #White, RGB(192,0,0), 9)
RBUTTON(30, "Apply", 182, 20)
Repeat
	e=WaitWindowEvent()
	If e=#PB_Event_CloseWindow
		Break
	EndIf
	If e=#PB_Event_Gadget
		ev=EventType()
		If ev=#PB_EventType_LeftClick
			g=EventGadget()
			If g=10 Or g=20 Or g=30
				Break
			EndIf
		EndIf
	EndIf
ForEver
CloseWindow(1)
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Why no SetGadgetColor for buttons?

Post by BarryG »

Nice, DeanH!
Denis
Enthusiast
Enthusiast
Posts: 704
Joined: Fri Apr 25, 2003 5:10 pm
Location: Doubs - France

Re: Why no SetGadgetColor for buttons?

Post by Denis »

After reflection, here is a code to colorize buttons, disabled buttons are not taken into account because it is necessary to mix the base colour with button theme color using the alpha layer, it's simpler with Gdi+ (at least for me, I know that not all know Gdi+).

The button must be "#BS_OWNERDRAW", that's what the BC_ButtonGadget() function does.
From there you have to draw and control everything.

This code will help some coders to understand how to proceed.

You'll find a code From french coder 'Le Soldat Inconnu' we discussed on French forum in 2005 ...
It's about themes
Time flies.

https://www.purebasic.fr/french/viewtop ... s&start=19


Button color example
It won't be run with X86 asm backend due to Import, so use C backend

Button style is only #Button_XPStyle here.

Code: Select all

EnableExplicit

;- .      ...  Import  ...
Import "msimg32.lib"
      GradientFill(a.l, b.l, c.l, d.l, e.l, f.l) As "GradientFill"
      ;TransparentBlt(a.l, b.l, c.l, d.l, e.l, f.l, g.l, h.l, i.l, j.l, k.l) As "_TransparentBlt"
EndImport

;-
;- .      ...  Constant/Enumeration  ...
Enumeration Window 1
      #MainWindow
EndEnumeration

Enumeration Font 1
      #ButtonFont
EndEnumeration
Enumeration Gadget 1
      #Button_Open
      #Button_Read
      #Button_three
      #Button_Quit
EndEnumeration
Enumeration 0 ;// LinearGradientMode
      #LinearGradientModeHorizontal
      #LinearGradientModeVertical
      #LinearGradientModeForwardDiagonal
      #LinearGradientModeBackwardDiagonal
EndEnumeration
Enumeration 0 ;// les styles des boutons
      ;// utilisé dans les tests
      #First_ButtonStyle
      ;// Les boutons utilisent les thèmes et styles, valeur par défaut
      #Button_XPStyle = #First_ButtonStyle
      ;// Encadrement des boutons carrés
      #Button_oldStyle
      ;// Les boutons ont une bordure épaisse
      #Button_ThickFrame
      ;// utilisé dans les tests
      #Last_ButtonStyle = #Button_ThickFrame
EndEnumeration
#WindowOptions = #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered
; Gestion souris/Mouse management
#TME_HOVER        = 1
#TME_LEAVE        = 2
#My_HOVER_DEFAULT = 2

;// masque pour ne pas prendre en compte la couche alpha
#Remove_Alpha = $00FFFFFF

; Theme_XP  States
#PBS_NORMAL    = 1
#PBS_HOT       = 2
#PBS_PRESSED   = 3
#PBS_DISABLED  = 4
#PBS_DEFAULTED = 5

; Theme_XP  Button types
#BP_PUSHBUTTON  = 1
#BP_RADIOBUTTON = 2
#BP_CHECKBOX    = 3
#BP_GROUPBOX    = 4
#BP_USERBUTTON  = 5

; Theme_XP  Button styles
#BS_MULTILINE  = $2000
#BS_BOTTOM     = $800
#BS_CENTER     = $300
#BS_MULTILINE  = $2000
#BS_TOP        = $400
#BS_VCENTER    = $C00
#BS_ICON       = $40
#BS_BITMAP     = $80
#BS_FLAT       = $8000
#DT_SINGLELINE = $20
#BS_LEFT       = $100
#BS_RIGHT      = $200


; winuser.h
; /*
;  * Owner draw state
;  */
; #define ODS_SELECTED    0x0001
; #define ODS_GRAYED      0x0002
; #define ODS_DISABLED    0x0004
; #define ODS_CHECKED     0x0008
; #define ODS_FOCUS       0x0010
; #if(WINVER >= 0x0400)
; #define ODS_DEFAULT         0x0020

;-
;- .      ...  Structures  ...
;-
Structure BC_OwnerDrawButtton Align #PB_Structure_AlignC
      ;// Couleur du gradient supérieur mode normal/colour of the upper gradient normal mode
      Normal_BackGround_UpperColor.i
      ;// Couleur du gradient inférieur mode normal/colour of lower gradient normal mode
      Normal_BackGround_LowerColor.i
      
      ;// Couleur du gradient supérieur mode bouton selectionné/colour of upper gradient button mode selected
      Selected_BackGround_UpperColor.i
      ;// Couleur du gradient inférieur mode bouton selectionné/colour of lower gradient button mode selected
      Selected_BackGround_LowerColor.i
      
      ;// Couleur du gradient supérieur mode survolé/colour of upper gradient hover mode
      MouseOver_BackGround_UpperColor.i
      ;// Couleur du gradient inférieur mode survolé/colour of lower gradient hover mode
      MouseOver_BackGround_LowerColor.i
      
      ;// Couleur du texte bouton normal/button text colour in normal state
      Normal_TextColor.i
      ;// Couleur du texte bouton sélectionné/button text colour in selected state
      Selected_TextColor.i
      ;// Couleur du texte  bouton survolé/button text colour in hovered state
      MouseOver_TextColor.i
      
      ;// transparence des couleur, par défaut à 255 opacité complète, à 0 compètement transparent
      ;// color transparency, by default full opacity value = 255 , 0 full transparent
      ;// 'mode Normal'
      Normal_Alpha.i
      ;// 'mode sélectionné'
      Selected_Alpha.i
      ;// 'mode survolé'
      MouseOver_Alpha.i
      ;// Style  du bouton/button style
      BC_ButtonStyle.i
      ;//    #Button_XPStyle      : Les boutons utilisent les thèmes XP ou supérieur
      ;//    #Button_oldStyle     : Encadrement carrés des boutons
      ;//    #Button_ThickFrame   : Encadrement carrés des boutons avec la bordure est épaisse
      ;//    #Button_XPStyle: Buttons use XP or higher themes
      ;//    #Button_oldStyle: Square outer border of buttons
      ;//    #Button_ThickFrame: Square outer border of buttons with a thick border
      
      ;// couleur de la bordure extérieure pour le style #Button_ThickFrame
      ;// outer border color for #Button_ThickFrame style
      BC_ThickFrameColor.i
      
      ;// Type du gradient/gradient type
      LinearGradientMode.i
      
      ;// Identifiant statique du bouton/static button Id
      StaticGadgetID.i
      
      ;// mémorise la procédure d'origine du bouton/stores original procedure of the button
      *OlBoutondProc
      
      ;// Indique si le bouton est survolé ou non, à #True, la souris survol le bouton, sinon #False
      ;// Indicates whether the button is hovered or not, #True, the mouse hovers over the button, otherwise #False
      IsMouseOver.i
      
EndStructure
Structure BC_SubClassing_Infos
      ;// Handle de la fenêtre
      BC_SubClassed_Window.i
      ;// Identifiant PureBasic de la fenêtre
      BC_SubClassed_WindowStaticID.i
      ;// Chaine utilisée par GetProp_(),SetProp_(), RemoveProp_()
      BC_SubClassed_WindowString$
EndStructure
Structure RectF
      x.f
      y.f
      width.f
      height.f
EndStructure

;- .      ...  Variables globales/Global vars  ...
;// mémorise les infos de chaque bouton
Global NewMap GLB_Bouton.BC_OwnerDrawButtton()
;// liste chainée mémorisant la chaine d'identification pour chaque fenêtre subclassée
Global NewList BC_Window_SubClassing_Infos.BC_SubClassing_Infos()
;// mémorise le chemin + nom fichier de l'application
Global GLB_GetModuleFileName$
;// mémorise le handle du thème XP du bouton
Global GLB_hTheme
;// Police des boutons
Global GLB_ButtonFont
;// compteur utilisé pour générer des chaines différentes pour le subclassing
Global BC_Window_SubClassing_counter.q

;-
;- .      ...  Declare procedures  ...
Declare.i BC_Window_Callback(WindowID, Message, wParam, lParam)
Declare.i BC_BoutonCallback(window, message, wParam, lParam)
Declare.i BC_SetButtonGradient_EX(Gadget, Normal_BackGround_UpperColor, Normal_BackGround_LowerColor, Normal_TextColor, Selected_BackGround_UpperColor, Selected_BackGround_LowerColor, Selected_TextColor, MouseOver_BackGround_UpperColor, MouseOver_BackGround_LowerColor, MouseOver_TextColor, LinearGradientMode.i, Normal_Alpha.i, Selected_Alpha.i, MouseOver_Alpha.i)
Declare   BC_UnInit()
Declare.i BC_Init_Theme(Mainwindow)
Declare   BC_UnInit_Theme()
Declare.i BC_UnInit_Window(WindowStaticID)
Declare.i BC_SubClass_Window(WindowStaticID)

;-
;- .      ...  Text Dimensions  ...
Procedure.i GetTextDimensions(Font, *Dimension.size, Texte$)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: GetTextDimensions()
      ;//
      ;// BUT: Retourne la largeur et hauteur du texte formaté avec une police
      ;//
      ;// PARAMS: Font - La police utilisée (identifiant statique)
      ;//         Texte$ - le texte à formater
      ;//
      ;// RETOURNE:  -1 si erreur, sinon #True
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;// mémorise l'image créée
      Protected Image
      ;// retrouve les infos de la font
      Protected finfo.LOGFONT
      ;// Mémorise la FontId
      Protected MyFontId
      
      If IsFont(Font)
            MyFontId = FontID(Font)
      ElseIf Font And GetObject_(Font, SizeOf(LOGFONT),@finfo)
            ;// ici c'est directement le handle de la font
            MyFontId = Font
      EndIf
      
      If MyFontId = 0
            ProcedureReturn -1
      EndIf
      
      Image = CreateImage(#PB_Any, 400, 80)
      If Image = 0
            ProcedureReturn -1
      EndIf
      
      If StartDrawing(ImageOutput(Image)) = 0
            FreeImage(Image)
            ProcedureReturn -1
      EndIf
      
      DrawingFont(MyFontId)
      ResetStructure(*Dimension, size)
      *Dimension\cx = TextWidth(Texte$)
      *Dimension\cy = TextHeight(Texte$)
      StopDrawing()
      FreeImage(Image)
      ProcedureReturn #True
EndProcedure
;-
;- .      ...  Init  ...
Procedure.i BC_Init_ButtonColor()
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_Init_ButtonColor()
      ;//
      ;// BUT: Initialiser les éléments de la librairie des boutons couleur
      ;//         Les thèmes XP des boutons
      ;//
      ;// PARAMS: aucun
      ;//
      ;// RETOURNE: #True en cas de succès
      ;//         : #False en cas d'erreur
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      
      ;// mémorise le nom complet de l'application en cours d'execution
      GLB_GetModuleFileName$ = Space(#MAX_PATH)
      
      If Len(GLB_GetModuleFileName$) = #MAX_PATH
            GetModuleFileName_(0,@GLB_GetModuleFileName$,#MAX_PATH)
            ProcedureReturn #True
      Else
            ProcedureReturn #False
      EndIf
EndProcedure

Procedure BC_UnInit_ButtonColor()
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_UnInit_ButtonColor()
      ;//
      ;// BUT:    Libérer les ressources de la librairie des boutons couleur
      ;//         Les thèmes XP des boutons
      ;//         Le subclassing des fenêtres des boutons couleurs
      ;//
      ;// PARAMS: aucun
      ;//
      ;// RETOURNE: #True en cas de succès
      ;//         : #False en cas d'erreur
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      
      BC_UnInit_Theme()
      BC_UnInit_Window(-1)
EndProcedure
Procedure.i BC_Init_Window(WindowStaticID)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_Init_Window()
      ;//
      ;// BUT: Initialiser les éléments de la librairie des boutons couleur
      ;//         Les thèmes XP pour les boutons
      ;//
      ;// PARAMS: WindowStaticID - indentifiant statique de la fenêtre (#fenetre)
      ;//
      ;// RETOURNE: #True en cas de succès
      ;//         : #False en cas d'erreur
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      
      If IsWindow(WindowStaticID) = #False
            ProcedureReturn #False
      EndIf
      
      If GLB_hTheme = 0
            
            BC_Init_Theme(WindowStaticID)
            If GLB_hTheme = 0
                  ProcedureReturn #False
            EndIf
            
      EndIf
      
      ProcedureReturn BC_SubClass_Window(WindowStaticID)
      
EndProcedure
Procedure.i BC_UnInit_Window(WindowStaticID)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_UnInit_Window()
      ;//
      ;// BUT: Retirer les infos de subclassing de la fenêtre identifiée par WindowStaticID
      ;//
      ;// PARAMS: WindowStaticID - identifiant statique de la fenêtre principale du programme
      ;//                          si WindowStaticID = -1, c'est que la procedure BC_Init_ButtonColor() l'a appelé
      ;//                          pour libérer les ressources éventuellement oubliées
      ;//
      ;// RETOURNE: #True en cas de succès
      ;//         : #False en cas d'erreur
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      
      ;// mémorise l'adresse de la procédure de traitement d'origine de la fenêtre WindowStaticID
      Protected *OriginProc
      ;// mémorise le résultat de RemoveProp_()
      Protected resultat
      
      Select WindowStaticID
            Case -1
                  ;// utilisée par BC_Init_ButtonColor()
                  ForEach (BC_Window_SubClassing_Infos())
                        ;// on se positionne sur le bon élément
                        With BC_Window_SubClassing_Infos()
                              RemoveProp_(\BC_SubClassed_Window, \BC_SubClassed_WindowString$)
                        EndWith
                  Next
                  ClearList(BC_Window_SubClassing_Infos())
                  ProcedureReturn #True
                  
            Default
                  ;// teste si la fenêtre est valide
                  If IsWindow(WindowStaticID) = 0
                        ProcedureReturn #False
                  EndIf
                  
                  ForEach (BC_Window_SubClassing_Infos())
                        ;// on se positionne sur le bon élément
                        With BC_Window_SubClassing_Infos()
                              If \BC_SubClassed_WindowStaticID = WindowStaticID
                                    resultat = RemoveProp_(\BC_SubClassed_Window, \BC_SubClassed_WindowString$)
                                    SetWindowLongPtr_(\BC_SubClassed_Window, #GWL_WNDPROC , *OriginProc)
                                    DeleteElement(BC_Window_SubClassing_Infos())
                                    If resultat
                                          ProcedureReturn #True
                                    Else
                                          ProcedureReturn #False
                                    EndIf
                              EndWith
                        EndIf
                  Next
      EndSelect
      ProcedureReturn #False
EndProcedure
Procedure.i BC_Init_Theme(Mainwindow)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_Init_Theme()
      ;//
      ;// BUT: Charge le thème des boutons
      ;//
      ;// PARAMS: Mainwindow - Id static de la fenêtre concernée
      ;//
      ;// RETOURNE: #False si les thèmes ne sont pas chargés
      ;//           #True si les thèmes sont chargés
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ; Chaine unicode 'Button' utilisée pour le Theme des boutons
      GLB_hTheme = OpenThemeData_(WindowID(Mainwindow), @"Button")
      If GLB_hTheme
            ProcedureReturn #True
      EndIf
      ProcedureReturn #False
EndProcedure
Procedure BC_UnInit_Theme()
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_UnInit_Theme()
      ;//
      ;// BUT: Libères les ressources associées au thème du bouton
      ;//
      ;// PARAMS: Aucun
      ;//
      ;// RETOURNE: rien
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      
      ;// on ferme le theme XP
      If GLB_hTheme
            CloseThemeData_(GLB_hTheme)
      EndIf
      GLB_hTheme = 0
EndProcedure

Procedure BC_Init_Programme()
      ;// mémorise les valeurs pour le tableau
      Protected i
      
      GLB_ButtonFont = LoadFont(#ButtonFont, "Arial", 12, #PB_Font_Bold|#PB_Font_Italic)
      
      ;// initialisation des fonctions
      BC_Init_ButtonColor()
      
EndProcedure
Procedure BC_UnInit_Programme()
      BC_UnInit_ButtonColor()
EndProcedure
;-
;- .      ...  Interface  ...
Procedure.i BC_SetButtonGradient(Gadget, BackGround_UpperColor, BackGround_LowerColor, TextColor, LinearGradientMode.i, Alpha.i = 255)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_SetButtonGradient()
      ;//
      ;// BUT: Définir la couleur du bouton identifié par Gadget
      ;// PARAMS: Gadget - identifiant statique du bouton (et non pas GadgetID(Gadget))/ static id gadget
      ;//         BackGround_UpperColor - Couleur du dégradé en haut du bouton ou à gauche
      ;//                                 Color of the gradient at the top  Or on the left of the button
      ;//         BackGround_LowerColor - Couleur du dégradé en bas du bouton ou à droite/
      ;//                                 Color of the gradient at the bottom or on the right of the button
      ;//         TextColor  - Couleur du texte/text color
      ;//         LinearGradientMode - une des 4 valeur suivante pour le dégradé  (#LinearGradientModeVertical par défaut)
      ;//                              one of the following 4 values for the gradient (#LinearGradientModeVertical by default)
      ;//             #LinearGradientModeHorizontal       : Spécifie un dégradé de gauche à droite/Specifies a left-to-right gradient
      ;//             #LinearGradientModeVertical         : Spécifie un dégradé du haut vers le bas/Specifies a gradient from top to bottom
      ;//         Alpha - La transparence du dégradé/The transparency of the gradient :
      ;//            255 opacité complète (valeur par défaut), 0 transparence complète
      ;//            255 full opacity (default), 0 full transparency
      ;// RETOURNE/RETURNS : #True   en cas de succès/if successful
      ;//                    #False  en cas d'erreur/in case of failure
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ProcedureReturn BC_SetButtonGradient_EX(Gadget, BackGround_UpperColor, BackGround_LowerColor, TextColor, BackGround_UpperColor, BackGround_LowerColor, TextColor, BackGround_LowerColor, BackGround_UpperColor, TextColor, LinearGradientMode, Alpha, Alpha, Alpha)
EndProcedure
Procedure.i BC_HoverButtonGradient(Gadget, BackGround_UpperColor, BackGround_LowerColor, TextColor, LinearGradientMode.i, Alpha.i = 255)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_SetHover_ButtonGradient()
      ;//
      ;// BUT: Définir la couleur du bouton identifié par Gadget lorsque la souris survol le bouton sans le sélectionner
      ;//
      ;// PARAMS: Gadget - identifiant statique du bouton (et non pas GadgetID(Gadget))
      ;//         BackGround_UpperColor - Couleur du dégradé en haut du bouton
      ;//         BackGround_LowerColor - Couleur du dégradé en bas du bouton
      ;//         TextColor  - Couleur du texte
      ;//         LinearGradientMode - une des 4 valeur suivante pour le dégradé  (#LinearGradientModeVertical par défaut)
      ;//             #LinearGradientModeHorizontal : Spécifie un dégradé de gauche à droite.
      ;//             #LinearGradientModeVertical : Spécifie un dégradé du haut vers le bas.
      ;//         Alpha - La transparence du dégradé  :
      ;//            255 opacité complète (valeur par défaut), 0 transparence complète
      ;//
      ;// RETOURNE/RETURNS : #True   en cas de succès/if successful
      ;//                    #False  en cas d'erreur/in case of failure
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      
      ProcedureReturn BC_SetButtonGradient_EX(Gadget, -1, -1, -1, -1, -1, -1, BackGround_UpperColor, BackGround_LowerColor, TextColor, LinearGradientMode, -1, -1, Alpha)
EndProcedure

Procedure.i BC_SelectedButtonGradient(Gadget, BackGround_UpperColor, BackGround_LowerColor, TextColor, LinearGradientMode.i, Alpha.i = 255)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_SelectedButtonGradient()
      ;//
      ;// BUT: Définir la couleur du bouton identifié par Gadget lorsque le bouton est sélectionné
      ;//
      ;// PARAMS: Gadget - identifiant statique du bouton (et non pas GadgetID(Gadget))
      ;//         BackGround_UpperColor - Couleur du dégradé en haut du bouton
      ;//         BackGround_LowerColor - Couleur du dégradé en bas du bouton
      ;//         TextColor  - Couleur du texte
      ;//         LinearGradientMode - une des 4 valeur suivante pour le dégradé  (#LinearGradientModeVertical par défaut)
      ;//             #LinearGradientModeHorizontal : Spécifie un dégradé de gauche à droite.
      ;//             #LinearGradientModeVertical : Spécifie un dégradé du haut vers le bas.
      ;//             #LinearGradientModeForwardDiagonal : Spécifie un dégradé du haut à gauche vers le bas à droite.
      ;//             #LinearGradientModeBackwardDiagonal : Spécifie un dégradé du haut à droite vers le bas à gauche.
      ;//         Alpha - La transparence du dégradé  :
      ;//            255 opacité complète (valeur par défaut), 0 transparence complète
      ;//
      ;// RETOURNE/RETURNS : #True   en cas de succès/if successful
      ;//                    #False  en cas d'erreur/in case of failure
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      
      ProcedureReturn BC_SetButtonGradient_EX(Gadget, -1, -1, -1, BackGround_LowerColor, BackGround_UpperColor, TextColor, -1, -1, -1, LinearGradientMode, -1, Alpha, -1)
EndProcedure
Procedure BC_SetButtonGradient_EX(Gadget, Normal_BackGround_UpperColor, Normal_BackGround_LowerColor, Normal_TextColor, Selected_BackGround_UpperColor, Selected_BackGround_LowerColor, Selected_TextColor, MouseOver_BackGround_UpperColor, MouseOver_BackGround_LowerColor, MouseOver_TextColor, LinearGradientMode.i, Normal_Alpha.i, Selected_Alpha.i, MouseOver_Alpha.i)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_SetButtonGradient_EX()
      ;//
      ;// BUT: Définir la couleur du bouton identifié par Gadget
      ;//        Cette fonction est appelée par d'autres fonctions, à éviter d'utiliser directement
      ;//
      ;// RETOURNE/RETURNS : #True   en cas de succès/if successful
      ;//                    #False  en cas d'erreur/in case of failure
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;// mémorise le résultat de la fonction
      Protected resultat
      
      ;// Teste si le gadget existe
      If IsGadget(Gadget) = 0
            ProcedureReturn #False
      EndIf
      
      ;// Teste si le gadget est bien un bouton
      If GadgetType(Gadget) <> #PB_GadgetType_Button
            ProcedureReturn #False
      EndIf
      
      ;// teste s'il existe un élément
      If Not(MapSize(GLB_Bouton()) And FindMapElement((GLB_Bouton()), Str(GadgetID(Gadget))))
            ProcedureReturn #False
      EndIf
      
      ;// couleur du gradient supérieur mode normal
      Select Normal_BackGround_UpperColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\Normal_BackGround_UpperColor = Normal_BackGround_UpperColor & #Remove_Alpha
      EndSelect
      
      ;// couleur du gradient inférieur mode normal
      Select Normal_BackGround_LowerColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\Normal_BackGround_LowerColor = Normal_BackGround_LowerColor & #Remove_Alpha
      EndSelect
      
      ;// Couleur du texte bouton normal
      Select Normal_TextColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\Normal_TextColor = Normal_TextColor & #Remove_Alpha
      EndSelect
      
      ;// couleur du gradient supérieur mode bouton selectionné
      Select Selected_BackGround_UpperColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\Selected_BackGround_UpperColor = Selected_BackGround_UpperColor & #Remove_Alpha
      EndSelect
      
      ;// couleur du gradient inférieur mode bouton selectionné
      Select Selected_BackGround_LowerColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\Selected_BackGround_LowerColor = Selected_BackGround_LowerColor & #Remove_Alpha
      EndSelect
      
      ;// Couleur du texte bouton sélectionné
      Select Selected_TextColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\Selected_TextColor = Selected_TextColor & #Remove_Alpha
      EndSelect
      
      ;// couleur du gradient supérieur mode survolé par souris
      Select MouseOver_BackGround_UpperColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\MouseOver_BackGround_UpperColor  = MouseOver_BackGround_UpperColor & #Remove_Alpha
      EndSelect
      
      ; couleur du gradient inférieur mode survolé par souris
      Select MouseOver_BackGround_LowerColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\MouseOver_BackGround_LowerColor  = MouseOver_BackGround_LowerColor & #Remove_Alpha
      EndSelect
      
      ;// Couleur du texte  bouton survolé
      Select MouseOver_TextColor
            Case -1
                  ;// on ne change pas la couleur
                  
            Default
                  GLB_Bouton()\MouseOver_TextColor   = MouseOver_TextColor & #Remove_Alpha
      EndSelect
      
      ;// la tansparence appliquée au dégradé en mode normal
      Select Normal_Alpha
            Case -1
                  ;// on ne modifie pas la valeur
                  
            Case 0 To 255
                  ;// valeur Ok
                  GLB_Bouton()\Normal_Alpha = Normal_Alpha
                  
            Default
                  ;// valeur non Ok, on force à 255
                  GLB_Bouton()\Normal_Alpha = 255
      EndSelect
      
      ;// la tansparence appliquée au dégradé en mode sélectionné
      Select Selected_Alpha
            Case -1
                  
                  ;// on ne modifie pas la valeur
            Case 0 To 255
                  ;// valeur Ok
                  GLB_Bouton()\Selected_Alpha = Selected_Alpha
                  
            Default
                  ;// valeur non Ok, on force à 255
                  GLB_Bouton()\Selected_Alpha = 255
      EndSelect
      
      ;// la tansparence appliquée au dégradé en mode survolé
      Select MouseOver_Alpha
            Case -1
                  
                  ;// on ne modifie pas la valeur
            Case 0 To 255
                  ;// valeur Ok
                  GLB_Bouton()\MouseOver_Alpha = MouseOver_Alpha
                  
            Default
                  ;// valeur non Ok, on force à 255
                  GLB_Bouton()\MouseOver_Alpha = 255
      EndSelect
      
      ;// Type de dégradé
      Select LinearGradientMode
            Case  #LinearGradientModeHorizontal To #LinearGradientModeBackwardDiagonal
                  ;// valeur Ok
                  GLB_Bouton()\LinearGradientMode = LinearGradientMode
                  
            Default
                  ;// valeur non Ok, on corrige
                  GLB_Bouton()\LinearGradientMode = #LinearGradientModeVertical
      EndSelect
      
      ProcedureReturn #True
EndProcedure

Procedure.i BC_ButtonGadget(Gadget,  x, y, Largeur, Hauteur, Texte$, Options = 0)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_ButtonGadget()
      ;//
      ;// BUT: Créer le bouton gadget qui sera colorisé, en subclassant le bouton
      ;// PURPOSE: Creates the buttongadget that will be coloured, by subclassing the button
      ;//
      ;// PARAMS: Gadget - identifiant statique du bouton (et non pas GadgetID(Gadget))
      ;//         x - position en x du bouton/x button position
      ;//         y - position en y du bouton/y button position
      ;//         Largeur - Largeur du bouton/Button width
      ;//         Hauteur - Hauteur du bouton/Button height
      ;//         Options - Permet de définir les styles du bouton, par exemple l'alignement à droite ou centré etc.
      ;//                   Paramètre optionnel
      ;//                   Les options sont les mêmes que pour la commande PB ButtonGadget()
      ;//                   Allows you to define the styles of the button, e.g. right or center alignment etc.
      ;//                   Optional parameter
      ;//                   Otions are the same as for the PB ButtonGadget() command
      ;//
      ;// RETOURNE : Le numéro du gadget en cas de succès/number id of gadget if successful
      ;//          : #False en cas d'erreur/#False in case of failure
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;// mémorise le résultat de la fonction/stores function result
      Protected resultat
      
      ; Crée un bouton dessiné par le propriétaire.
      ; La fenêtre propriétaire reçoit un message WM_DRAWITEM lorsqu'un aspect visuel du bouton a changé.
      ; Ne combinez pas le style BS_OWNERDRAW avec d'autres styles de bouton.
      ; Creates an owner-drawn button.
      ; The owner window receives a WM_DRAWITEM message when a visual aspect of the button has changed.
      ; Do Not combine the BS_OWNERDRAW style With any other button styles.
      resultat = ButtonGadget(Gadget, x, y, Largeur, Hauteur, Texte$, Options | #BS_OWNERDRAW)
      If Not(resultat)
            
            ProcedureReturn #False
            
      EndIf
      
      
      If Gadget <> #PB_Any
            resultat = Gadget
      EndIf
      
      If AddMapElement(GLB_Bouton(), Str(GadgetID(resultat))) = 0
            SetWindowLongPtr_(GadgetID(resultat), #GWL_STYLE, GetWindowLongPtr_(GadgetID(resultat), #GWL_WNDPROC) & ~#BS_OWNERDRAW)
            ProcedureReturn #False
      EndIf
      
      GLB_Bouton()\StaticGadgetID = resultat
      GLB_Bouton()\OlBoutondProc = SetWindowLongPtr_(GadgetID(resultat), #GWL_WNDPROC, @BC_BoutonCallback())
      ProcedureReturn GLB_Bouton()\StaticGadgetID
      
EndProcedure
Procedure.i BC_SubClass_Window(WindowStaticID)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_SubClass_Window()
      ;//
      ;// BUT: Subclasser la fenêtre pour intercepter certains messages
      ;//
      ;// PARAMS: WindowStaticID - identifiant statique de la fenêtre principale du programme
      ;//
      ;// RETOURNE/RETURNS : #True   en cas de succès/if successful
      ;//                    #False  en cas d'erreur/in case of failure
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;// mémorise l'adresse de la procedure d'origine
      Protected *OriginProc
      
      If Not(IsWindow(WindowStaticID))
            ProcedureReturn #False
      EndIf
      
      ;// positionne l'erreur à 0 avant l'appel de SetWindowLongPtr
      SetLastError_(0)
      *OriginProc = SetWindowLongPtr_(WindowID(WindowStaticID), #GWL_WNDPROC , @BC_Window_Callback())
      If *OriginProc = 0 And GetLastError_()
            ;// c'est une erreur
            ProcedureReturn #False
      EndIf
      
      ;// création de la chaine d'identification utilisée par GetProp_(),SetProp_(), RemoveProp_()
      LastElement(BC_Window_SubClassing_Infos())
      If AddElement(BC_Window_SubClassing_Infos()) = 0
            ;// erreur
            SetWindowLongPtr_(WindowID(WindowStaticID), #GWL_WNDPROC , *OriginProc)
            ProcedureReturn #False
      EndIf
      
      ;// incrémentation du compteur
      BC_Window_SubClassing_counter + 1
      ;// définition des champs
      With BC_Window_SubClassing_Infos()
            \BC_SubClassed_Window = WindowID(WindowStaticID)
            \BC_SubClassed_WindowStaticID = WindowStaticID
            \BC_SubClassed_WindowString$ = GetFilePart(GLB_GetModuleFileName$) + "_" +  RSet(Str(BC_Window_SubClassing_counter), SizeOf(quad), "0")
            ;//subclass la fenêtre
            Protected SetProp
            SetProp = SetProp_(\BC_SubClassed_Window, @\BC_SubClassed_WindowString$, *OriginProc)
            If SetProp = 0
                  ;// erreur de subclassing
                  SetWindowLongPtr_(\BC_SubClassed_Window, #GWL_WNDPROC , *OriginProc)
                  BC_Window_SubClassing_counter - 1
                  DeleteElement(BC_Window_SubClassing_Infos())
                  ProcedureReturn #False
            EndIf
      EndWith
      ProcedureReturn #True
EndProcedure
;-
Procedure CreateInterface()
      ;// mémorise les dimensions du texte/store text dimensions
      Protected Dimension.size
      ; dimensions de chaque bouton/ dimensions of each button
      Protected x, y, width, height
      ; texte du bouton/button text
      Protected Texte$
      ; Fenêtre principale/Main window
      If OpenWindow(#MainWindow, 0, 0, 800, 500, "Button color", #WindowOptions) = 0
            ; error
            End
      EndIf
      
      BC_Init_Window(#MainWindow)
      
      
      ; Boutons/Buttons
      ;- #Button Quit
      Texte$ = "Quitter"
      If GetTextDimensions(GLB_ButtonFont, @Dimension, Texte$) = -1
            Dimension\cx = 200 : Dimension\cy = 25
      EndIf
      Dimension\cx + 20
      
      x = WindowWidth(#MainWindow) - Dimension\cx - 20
      y = WindowHeight(#MainWindow) - 60
      width = Dimension\cx :  height = 40
      BC_ButtonGadget(#Button_Quit ,x, y, width, height,  Texte$)
      
      ; Définit le dégradé de couleur du bouton en mode normal/Sets the button color gradient in normal mode
      BC_SetButtonGradient(#Button_Quit, #Yellow, #Red, #White, #LinearGradientModehorizontal, 255)
      ; Définit le dégradé de couleur du bouton en mode survolé/Sets the button color gradient in hover mode
      BC_HoverButtonGradient(#Button_Quit, #Red, #Yellow, $4C3924, #LinearGradientModehorizontal, 255)
      ; Définit le dégradé de couleur du bouton en mode sélectionné/Sets the button color gradient in selected mode
      BC_SelectedButtonGradient(#Button_Quit, $3DC4FC, $3DC4FC, #Blue, #LinearGradientModehorizontal)
      ; Définit la police bouton/Sets button font
      SetGadgetFont(#Button_Quit, GLB_ButtonFont)
      
      ;- #Button Open
      Texte$ = "Open"
      If GetTextDimensions(GLB_ButtonFont, @Dimension, Texte$) = -1
            Dimension\cx = 200 : Dimension\cy = 25
      EndIf
      Dimension\cx + 20
      x = 20
      y = WindowHeight(#MainWindow) - 60
      width = Dimension\cx :  height = 40
      BC_ButtonGadget(#Button_Open ,x, y, width, height,  Texte$)
      
      ; Définit le dégradé de couleur du bouton en mode normal/Sets the button color gradient in normal mode
      BC_SetButtonGradient(#Button_Open, #Red, #Red, #White, #LinearGradientModehorizontal, 255)
      ; Définit le dégradé de couleur du bouton en mode survolé/Sets the button color gradient in hover mode
      BC_HoverButtonGradient(#Button_Open, #White, #White, #Red, #LinearGradientModehorizontal, 255)
      ; Définit le dégradé de couleur du bouton en mode sélectionné/Sets the button color gradient in selected mode
      BC_SelectedButtonGradient(#Button_Open, $A6AEFF, $A6AEFF, #Black, #LinearGradientModehorizontal)
      ; Définit la police bouton/Sets button font
      SetGadgetFont(#Button_Open, GLB_ButtonFont)
      
      ;- #Button Read
      Texte$ = "Read"
      If GetTextDimensions(GLB_ButtonFont, @Dimension, Texte$) = -1
            Dimension\cx = 200 : Dimension\cy = 25
      EndIf
      Dimension\cx + 20
      x = GadgetX(#Button_Open) + GadgetWidth(#Button_Open) + 30
      y = WindowHeight(#MainWindow) - 60
      width = Dimension\cx :  height = 40
      BC_ButtonGadget(#Button_Read ,x, y, width, height,  Texte$)
      
      ; Définit le dégradé de couleur du bouton en mode normal/Sets the button color gradient in normal mode
      BC_SetButtonGradient(#Button_Read, $9E3171, $F19CCF, #White, #LinearGradientModehorizontal, 255)
      ; Définit le dégradé de couleur du bouton en mode survolé/Sets the button color gradient in hover mode
      BC_HoverButtonGradient(#Button_Read, $F39FD2, $F39FD2, $A1397F, #LinearGradientModehorizontal, 255)
      ; Définit le dégradé de couleur du bouton en mode sélectionné/Sets the button color gradient in selected mode
      BC_SelectedButtonGradient(#Button_Read, #White, #White, $B03171, #LinearGradientModehorizontal)
      ; Définit la police bouton/Sets button font
      SetGadgetFont(#Button_Read, GLB_ButtonFont)
      
      ;- #Button three
      Texte$ = " Button three "
      If GetTextDimensions(GLB_ButtonFont, @Dimension, Texte$) = -1
            Dimension\cx = 200 : Dimension\cy = 25
      EndIf
      Dimension\cx + 20
      x = GadgetX(#Button_Read) + GadgetWidth(#Button_Read) + 30
      width = Dimension\cx :  height = 40
      
      BC_ButtonGadget(#Button_three, x, y, width, height,  Texte$)
      
      ; Définit le dégradé de couleur du bouton en mode normal/Sets the button color gradient in normal mode
      BC_SetButtonGradient(#Button_three, #Green, $FFE100, #White, #LinearGradientModeVertical, 255)
      ; Définit le dégradé de couleur du bouton en mode survolé/Sets the button color gradient in hover mode
      BC_HoverButtonGradient(#Button_three, $FFE100, #Green, #Red, #LinearGradientModeVertical, 255)
      ; Définit le dégradé de couleur du bouton en mode sélectionné/Sets the button color gradient in selected mode
      BC_SelectedButtonGradient(#Button_three, $CBE030, $CBE030, #Black, #LinearGradientModeVertical)
      ; Définit la police bouton/Sets button font
      SetGadgetFont(#Button_three, GLB_ButtonFont)
      
EndProcedure
;-
;- .      ...  Gradient  ...
Procedure.i CreateGradient(Array gradient.TRIVERTEX(1), *rc.Rect, *gRect.GRADIENT_RECT, UpperColor, LowerColor, Alpha_Value)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
      ;// FONCTION/FUNCTION : CreateGradient()
      ;// BUT/PURPOSE : Création d'un gradient de couleur/Create a color gradient
      ;// PARAMETRES/PARAMETERS : gradient -  Structure contenant les informations de couleur et de position
      ;//                                      Structure contains color information and position information
      ;//                         *rc - it contains x-coordinate, in logical units, of the upper-left corner of the rectangle
      ;//                               it contains The y-coordinate, in logical units, of the upper-left corner of the rectangle.
      ;//                         *gRect - Couleur supérieure du dégradé
      ;//                         UpperColor - Couleur supérieure du dégradé
      ;//                         LowerColor - Couleur inférieure du dégradé
      ;//                         Alpha_Value - Valeur de la couche alpha (transparence)
      ;//
      ;// RETOURNE/RETURNS : #True   en cas de succès/if successful
      ;//                    #False  en cas d'erreur/in case of failure
      ;///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
      If *rc = 0 Or *gRect = 0
            ProcedureReturn #False
      EndIf
      
      ;// on défini le tableau du gradient
      gradient(0)\Red = Red(UpperColor) << 8
      gradient(0)\Green =  Green(UpperColor) << 8
      gradient(0)\Blue = Blue(UpperColor) << 8
      gradient(0)\Alpha = Alpha_Value
      
      gradient(1)\Red = Red(LowerColor) << 8
      gradient(1)\Green =  Green(LowerColor) << 8
      gradient(1)\Blue = Blue(LowerColor) << 8
      gradient(1)\Alpha = Alpha_Value
      
      gradient(0)\x = *rc\left
      gradient(0)\y = *rc\top
      
      gradient(1)\x = *rc\right
      gradient(1)\y = *rc\bottom
      
      *gRect\UpperLeft = 0
      *gRect\LowerRight = 1
      
      ProcedureReturn #True
EndProcedure
;-
;- .      ...  Callback  ...
Procedure.i BC_Window_Callback(Window, Message, wParam, lParam)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_Window_Callback()
      ;//
      ;// BUT: Callback dessinant les boutons couleur
      ;//
      ;// PARAMS: Window, Message, wParam, lParam
      ;//
      ;// RETOURNE: L'adresse de la procedure d'origine ou la procedure par défaut
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      
      Protected stateID, partID, ButtonText.s
      Protected BoutonStyle, TexteStyle, textWidth, textHeight, Font
      Protected TextColor, UpperColor, LowerColor, SavedDC
      Protected rc_ThemeContent.rect
      Protected *di.DRAWITEMSTRUCT
      Protected *brush, *OriginProc
      Protected Alpha_Value, hBmpTampon, hdcMem
      ;// mémorise les valeurs pour GradientFill
      Protected gRect.GRADIENT_RECT
      ;// mémorise les couleurs utilisées pour créer le dégradé linéaire
      Protected Dim vert.TRIVERTEX(1)
      
      If ListSize(BC_Window_SubClassing_Infos()) = 0
            ProcedureReturn DefWindowProc_(window, message, wParam, lParam)
      EndIf
      
      ForEach (BC_Window_SubClassing_Infos())
            ;// on se positionne sur le bon élément
            If BC_Window_SubClassing_Infos()\BC_SubClassed_Window = Window
                  Break
            EndIf
      Next
      
      *OriginProc = GetProp_(Window, BC_Window_SubClassing_Infos()\BC_SubClassed_WindowString$)
      If *OriginProc = 0
            ProcedureReturn DefWindowProc_(window, message, wParam, lParam)
      EndIf
      *di = lParam
      If *di
            Select Message
                  Case #WM_DRAWITEM
                        If *di\CtlType = #ODT_BUTTON
                              hdcMem = CreateCompatibleDC_(*di\hDC)
                              If hdcMem = 0
                                    ProcedureReturn CallWindowProc_(*OriginProc,Window, Message, wParam, lParam)
                              EndIf
                              
                              hBmpTampon = CreateCompatibleBitmap_(*di\hDC, GetDeviceCaps_(*di\hDC, #HORZRES), GetDeviceCaps_(*di\hDC, #VERTRES))
                              If hBmpTampon = 0
                                    DeleteDC_(hdcMem)
                                    ProcedureReturn CallWindowProc_(*OriginProc,Window, Message, wParam, lParam)
                              EndIf
                              
                              ;// sélectionne l'élément de la Map correspondant au bouton à dessiner
                              If (GLB_hTheme And
                                    MapSize(GLB_Bouton()) And
                                    FindMapElement(GLB_Bouton(), Str(GadgetID(*di\CtlID))) = #False)
                                    DeleteDC_(hdcMem)
                                    DeleteObject_(hBmpTampon)
                                    ProcedureReturn CallWindowProc_(*OriginProc,Window, Message, wParam, lParam)
                              EndIf
                              
                              ;// sélectionne le bmp dans le dc
                              SelectObject_(hdcMem, hBmpTampon)
                              
                              ;// sauvegarde du dc
                              SavedDC = SaveDC_(*di\hDC)
                              
                              If *di\itemState & #ODS_DISABLED
                                    ; partID = #BP_PUSHBUTTON
                                    ; stateID = #PBS_DISABLED
                                    ; Alpha_Value = GLB_Bouton()\Normal_Alpha
                                    ; Alpha_Value = 80
                                    ; TextColor = GLB_Bouton()\Normal_TextColor
                                    ;
                                    ; UpperColor = GLB_Bouton()\Normal_BackGround_LowerColor
                                    ;
                                    ; LowerColor = UpperColor
                                    
                              ElseIf *di\itemState & #ODS_SELECTED
                                    ; #define ODS_SELECTED    0x0001
                                    ; #define ODS_GRAYED      0x0002
                                    ; #define ODS_DISABLED    0x0004
                                    ; #define ODS_CHECKED     0x0008
                                    ; #define ODS_FOCUS       0x0010
                                    ; #if(WINVER >= 0x0400)
                                    ; #define ODS_DEFAULT         0x0020
                                    partID = #BP_PUSHBUTTON
                                    stateID = #PBS_PRESSED
                                    Alpha_Value = GLB_Bouton()\Selected_Alpha
                                    TextColor   = GLB_Bouton()\Selected_TextColor
                                    UpperColor      = GLB_Bouton()\Selected_BackGround_UpperColor
                                    LowerColor      = GLB_Bouton()\Selected_BackGround_LowerColor
                              Else
                                    partID = #BP_PUSHBUTTON
                                    stateID = #PBS_NORMAL
                                    If GLB_Bouton()\IsMouseOver
                                          Alpha_Value = GLB_Bouton()\MouseOver_Alpha
                                          TextColor = GLB_Bouton()\MouseOver_TextColor
                                          UpperColor = GLB_Bouton()\MouseOver_BackGround_UpperColor
                                          LowerColor = GLB_Bouton()\MouseOver_BackGround_LowerColor
                                    Else
                                          Alpha_Value = GLB_Bouton()\Normal_Alpha
                                          TextColor = GLB_Bouton()\Normal_TextColor
                                          UpperColor = GLB_Bouton()\Normal_BackGround_UpperColor
                                          LowerColor = GLB_Bouton()\Normal_BackGround_LowerColor
                                    EndIf
                              EndIf
                              
                              ;// on redessine le bouton
                              If IsThemeBackgroundPartiallyTransparent_(GLB_hTheme, partID, stateID)
                                    DrawThemeParentBackground_(*di\hwndItem, hdcMem, *di\rcItem)
                              EndIf
                              DrawThemeBackground_(GLB_hTheme, hdcMem, partID, stateID, *di\rcItem, 0)
                              GetThemeBackgroundContentRect_(GLB_hTheme, *di\hDC, partID, stateID, *di\rcItem, @rc_ThemeContent)
                              
                              Select GLB_Bouton()\LinearGradientMode
                                    Case #LinearGradientModehorizontal
                                          
                                          If CreateGradient(vert(), @rc_ThemeContent, @gRect, UpperColor, LowerColor, Alpha_Value)
                                                If GradientFill(hdcMem, @vert(), 2, @gRect, 1, #GRADIENT_FILL_RECT_H) = #False
                                                      DeleteDC_(hdcMem)
                                                      DeleteObject_(hBmpTampon)
                                                      If SavedDC
                                                            RestoreDC_(*di\hDC, SavedDC)
                                                      EndIf
                                                      ProcedureReturn CallWindowProc_(*OriginProc,Window, Message, wParam, lParam)
                                                EndIf
                                          EndIf
                                          
                                          
                                    Default  ;/ #LinearGradientModeVertical
                                          
                                          If CreateGradient(vert(), @rc_ThemeContent, @gRect, UpperColor, LowerColor, Alpha_Value)
                                                If GradientFill(hdcMem, @vert(), 2, @gRect, 1, #GRADIENT_FILL_RECT_V) = #False
                                                      DeleteDC_(hdcMem)
                                                      DeleteObject_(hBmpTampon)
                                                      If SavedDC
                                                            RestoreDC_(*di\hDC, SavedDC)
                                                      EndIf
                                                      ProcedureReturn CallWindowProc_(*OriginProc,Window, Message, wParam, lParam)
                                                EndIf
                                          EndIf
                                          
                              EndSelect
                              
                              ;// écriture du texte du bouton
                              ButtonText = GetGadgetText(*di\CtlID)
                              
                              If Len(ButtonText)
                                    
                                    ;// couleur texte , fond transparent
                                    SetTextColor_(hdcMem, TextColor)
                                    SetBkMode_(hdcMem, #TRANSPARENT)
                                    Font = GetGadgetFont(*di\CtlID)
                                    If Font
                                          SelectObject_(hdcMem, Font)
                                    EndIf
                                    ;// lecture du style du bouton
                                    BoutonStyle = GetWindowLongPtr_(*di\hwndItem, #GWL_STYLE)
                                    If BoutonStyle & #BS_RIGHT
                                          TexteStyle | #DT_RIGHT
                                    ElseIf BoutonStyle & #BS_LEFT
                                          TexteStyle | #DT_LEFT
                                    Else
                                          TexteStyle | #DT_CENTER
                                    EndIf
                                    
                                    If (Not(BoutonStyle & #BS_MULTILINE))
                                          TexteStyle | #DT_SINGLELINE | #DT_WORDBREAK | #DT_VCENTER
                                          
                                    Else
                                          TexteStyle | #DT_WORDBREAK
                                          ;// calcul du rectangle du texte à centrer et centrage
                                          DrawText_(hdcMem, @ButtonText, -1, @rc_ThemeContent, #DT_CALCRECT | TexteStyle)
                                          textWidth = rc_ThemeContent\right - rc_ThemeContent\left
                                          textHeight = rc_ThemeContent\bottom - rc_ThemeContent\top
                                          rc_ThemeContent\left = ((*di\rcItem\right - *di\rcItem\left) - (rc_ThemeContent\right - rc_ThemeContent\left)) / 2
                                          rc_ThemeContent\right = rc_ThemeContent\left + textWidth
                                          rc_ThemeContent\top = (*di\rcItem\bottom - *di\rcItem\top - textheight) / 2
                                          rc_ThemeContent\bottom = rc_ThemeContent\top + textheight
                                    EndIf
                                    
                                    ;// on écrit le texte
                                    DrawTextEx_(hdcMem, ButtonText, -1, @rc_ThemeContent, TexteStyle | #DT_EXPANDTABS , 0)
                                    ;// on copie le hDC de la mémoire vers celui du bouton
                                    BitBlt_(*di\hDC, 0, 0, *di\rcItem\right - *di\rcItem\left, *di\rcItem\bottom - *di\rcItem\top, hdcMem, 0, 0, #SRCCOPY)
                                    
                              EndIf
                              DeleteDC_(hdcMem)
                              DeleteObject_(hBmpTampon)
                              If SavedDC
                                    RestoreDC_(*di\hDC, SavedDC)
                              EndIf
                              ProcedureReturn #True
                        EndIf
            EndSelect
      EndIf
      
      ProcedureReturn CallWindowProc_(*OriginProc,Window, Message, wParam, lParam)
EndProcedure
Procedure.i BC_BoutonCallback(window, message, wParam, lParam)
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;//
      ;// FONCTION: BC_BoutonCallback()
      ;//
      ;// BUT: Callback d'interception des message de la sourris des boutons
      ;//
      ;// PARAMS: window, message, wParam, lParam)
      ;//
      ;// RETOURNE: 0 pour les message traités
      ;//           sinon  CallWindowProc_(GLB_Bouton()\OlBoutondProc, window, message, wParam, lParam)
      ;//
      ;///////////////////////////////////////////////////////////////////////////////////////////////////
      ;// structure TRACKMOUSEEVENT qui mémorise les infos de poursuite de la souris
      ;// TRACKMOUSEEVENT Structure that contains tracking information
      Protected bt.TRACKMOUSEEVENT
      
      
      If (MapSize(GLB_Bouton()) And FindMapElement(GLB_Bouton(), Str(window)))= #False
            ProcedureReturn DefWindowProc_(window, message, wParam, lParam)
      EndIf
      
      Select message
            Case #WM_DESTROY
                  SetWindowLongPtr_(window, #GWL_WNDPROC, GLB_Bouton()\OlBoutondProc)
                  DeleteMapElement(GLB_Bouton(), Str(window))
                  ProcedureReturn 0
                  
            Case #WM_MOUSEMOVE
                  BT\cbSize = SizeOf(TRACKMOUSEEVENT)
                  BT\dwFlags = #TME_HOVER | #TME_LEAVE
                  BT\dwHoverTime = #My_HOVER_DEFAULT
                  BT\hwndTrack = window
                  TrackMouseEvent_(@bt)
                  ProcedureReturn 0
                  
            Case #WM_MOUSEHOVER
                  If IsGadget(GLB_Bouton()\StaticGadgetID) And window = GadgetID(GLB_Bouton()\StaticGadgetID)
                        If GLB_Bouton()\IsMouseOver = #False
                              ; la souris survole le bouton
                              GLB_Bouton()\IsMouseOver = #True
                              ; redessine
                              InvalidateRect_(window, 0, 0)
                        EndIf
                  EndIf
                  ProcedureReturn 0
                  
            Case #WM_MOUSELEAVE
                  SetTimer_(window, 1, 25, 0)
                  ProcedureReturn 0
                  
            Case #WM_TIMER
                  KillTimer_(window, 1)
                  ; la souris ne survole plus le bouton
                  GLB_Bouton()\IsMouseOver = #False
                  ; redessine
                  InvalidateRect_(window, 0, 0)
                  ProcedureReturn 0
                  
      EndSelect
      ProcedureReturn CallWindowProc_(GLB_Bouton()\OlBoutondProc, window, message, wParam, lParam)
      
EndProcedure

;-
;- .      ...  Programme principal  ...
;- .      ...  Main Program  ...
Procedure Programme()
      ;// loop event value
      Protected Event
      
      BC_Init_Programme()
      ; create Interface, buttons etc.
      CreateInterface()
      
      Repeat
            Event = WaitWindowEvent()
            
            Select Event
                        
                  Case #PB_Event_Gadget
                        Select EventGadget()
                              Case #Button_Open
                                    MessageRequester("Info","#Button_Open  clicked")
                                    
                              Case #Button_Read
                                    MessageRequester("Info","#Button_Read  clicked")
                                    
                              Case #Button_three
                                    MessageRequester("Info","#Button_three  clicked")
                                    
                              Case #Button_Quit
                                    CloseWindow(#MainWindow)
                                    Break
                                    
                                    
                                    
                        EndSelect
                        
                  Case #PB_Event_CloseWindow
                        CloseWindow(#MainWindow)
                        Break
            EndSelect
      ForEver
      BC_UnInit_Programme()
EndProcedure

Programme()
Last edited by Denis on Tue Aug 09, 2022 5:41 am, edited 1 time in total.
A+
Denis
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Why no SetGadgetColor for buttons?

Post by BarryG »

Denis wrote: Mon Aug 08, 2022 5:56 pmIt won't be run with X86 asm backend due to Import, so use C backend
Just FYI: Your example works fine here with the 64-bit ASM backend. Nice example, too!
Denis
Enthusiast
Enthusiast
Posts: 704
Joined: Fri Apr 25, 2003 5:10 pm
Location: Doubs - France

Re: Why no SetGadgetColor for buttons?

Post by Denis »

Hi BarryG,

Tks.

Its better to use GDI+.

Gdi+ has anti-aliasing.

Gdi+ has several brushes with interesting effects and easy to use graphic functions for drawing ellipses etc.

Even though Gdi+ came with XP I think (it's old), the functions are more powerful than those of GDI.
VectorDrawing library uses Gdi+ for the Window version.
viewtopic.php?p=484747#p484747

I change a bit the code above
line 1061 + line 1073, added

Code: Select all

If SavedDC
      RestoreDC_(*di\hDC, SavedDC)
EndIf
and I changed the position of BC_UnInit_Program() when the window closes.
A+
Denis
Denis
Enthusiast
Enthusiast
Posts: 704
Joined: Fri Apr 25, 2003 5:10 pm
Location: Doubs - France

Re: Why no SetGadgetColor for buttons?

Post by Denis »

Tks AZJIO,

there are many ways to do the job.

I don't use #BCN_HOTITEMCHANGE, it may be more easy using it.
Tks again!
A+
Denis
Post Reply