Code : Tout sélectionner
; Canvas (Bouton, Boite à cocher, Option, Bascule, Image, Déroulant, Plat)
; Francisé et modifié par Micoute
; Source originale: http://www.purebasic.fr/english/viewtop ... 12&t=62198
DeclareModule MonBouton
Enumeration Bouton
#Type_Normal ; bouton normal par défaut
#Type_Deroulant ; bouton normal avec menu/liste déroulante
#Type_Bascule ; bouton plat (qui se comporte comme une case à cocher)
#Type_Coche ; bouton case à cocher
#Type_Radio ; bouton radio/option
#Type_BasculeRadio ; bouton plat (qui se comporte comme un radio/option)
EndEnumeration
; Propriétés/attributs-Definir/Obtenir
Enumeration Proprietes
#Prop_CoulFnd ; couleur de fond/principale interne
#Prop_CoulFndExt ; couleur de fond externe
#Prop_CoulBord ; couleur de la bordure
#Prop_CoulTxt ; couleur du texte
#Prop_Justif ; #PB_Text_Center ou #PB_Text_Right (pour aligner à gauche, utilisez 0)
#Prop_Type ; un des #Type_xxx
#Prop_Gradient ; 0...100
#Prop_Rayon ; comme défini avec RoundBox()
#Prop_Police ; numéro de police PB
#Prop_Menu ; numéro de menu PB
#Prop_Texte ;
#Prop_Image ; numéro image PB
#Prop_FaireTenirImage ; image fixe/redimensionnable
#Prop_Etat ; état souris
#Prop_Coche_ ; 0/1
#Prop_AuClic ; événement à effectuer
EndEnumeration
Declare.i ReinitialisationModele()
Declare.i DefinirModele(Propriete, Valeur) ; change une des propriétés par défaut - non associée à un bouton en particulier
Declare.i DefinirPropriete(Gadget, Propriete, Valeur)
Declare.i ObtenirPropriete(Gadget, Propriete)
Declare.i DefinirTexte(Gadget, Texte.s)
Declare.s ObtenirTexte(Gadget)
Declare.i Verifier(Gadget, Etat = #True)
Declare.i Activer(Gadget, Etat = #True)
Declare.i SiCoche_(Gadget)
Declare.i Siactif(Gadget)
Declare.i Liberer(Gadget)
Declare.i Redimensionner(Gadget, x, y, Largeur, Hauteur)
Declare.i Creer(Gadget, x, y, l, h, Texte.s, Conseil.s="")
Declare.i Clic(Gadget) ; simule un clic à partir du code
EndDeclareModule
Module MonBouton
EnableExplicit
#Marge_TexteX = 4 ; marge de gauche/droite du pixel lng texte
#Marge_TexteY = 1 ; marge haut/bas en pixel
#Largeur_Coche = 16 ; largeur de la zone de la case à cocher/radio
#Largeur_Deroulant = 20 ; largeur de la zone de la flèche bouton menu
Enumeration ; Etat du bouton Canvas
#Etat_SourisHors = 0 ; normal
#Etat_SourisDedans ; la souris est dedans
#Etat_ClicSouris ; le bouton est cliqué/poussé
#Etat_nonActif ; le bouton est désactivé
EndEnumeration
Global Coul_Desactive = $00707070
Global Coul_Dedans = $FBEEEEAF
Global Coul_Pousse = $FBE16941
Global CoulTxtPousse = $00FFFFFF
Global CoulTxtDedans = $00000000
Prototype.i _ProtoAuClic()
Structure SMonBouton
Gadget.i ; nombre de gadgets associés au canvas
Type.i ; #Type_xxx
CoulFnd.i ; couleur principale/fond
CoulCoin.i ; couleur fond/coin des 4 coins rayon d'arrondi utile si > 0
CoulBord.i ; couleur bord (-1 : aucun bord)
CoulTxt.i ; couleur d'avant plan ou couleur texte
Justif.i ; 0/#PB_Text_Center/#PB_Text_Right
Gradient.i ; niveau Gradient 0..100
Rayon.i ; rayon x/y
Police.i ; numéro police PB
Image.i ; numéro image PB
FaireTenirImage.i ; 0/1
Menu.i ; numéro menu popup PB
Texte.s ; texte
AuClic._ProtoAuClic ; routine à appeler lorsque le bouton reçoit plein clic (est poussé/vérifié /...)
;
Coche_.i ; 0/1 vérification pour bouton bascule
Etat.i ; #Prop_Etat_xxx : état souris courant
EndStructure
Global ML_BTN.SMonBouton ; bouton-modèle en cours : contient les valeurs attribuées par défaut - peut être changé par code (privé pour ce module)
;---<<<====>>> aides
Procedure.i _MonMelangeCouleurs(Coul1, Coul2, Mesure=50)
Protected R1, V1, B1, R2, V2, B2, Echelle.f = Mesure/100
R1 = Red(Coul1): V1 = Green(Coul1): B1 = Blue(Coul1)
R2 = Red(Coul2): V2 = Green(Coul2): B2 = Blue(Coul2)
ProcedureReturn RGB((R1*Echelle) + (R2 * (1-Echelle)), (V1*Echelle) + (V2 * (1-Echelle)), (B1*Echelle) + (B2 * (1-Echelle)))
EndProcedure
Procedure.i _MonDessinTexte(Txt.s,x,y,l,h, MrgX,MrgY, Just=0,Deroul=0)
Protected x1,x2,y1,y2, mx,al,my,ah
Protected i,j,lng,ll,hh,x0,l0
mx = MrgX ; marge horizontale x gauche/droite par défaut
my = MrgY ; marge verticale y haut/bas par défaut
al = l - 2*mx ; largeur donnée actuelle pour dessiner
ah = h - 2*my ; hauteur donnée actuelle pour dessiner
lng = Len(Txt) ; longueur du texte en caractères
If al <= 0 Or ah <= 0 Or lng <= 0 : ProcedureReturn : EndIf
ll = TextWidth(Txt) ; longueur du texte en pixels
hh = TextHeight(Txt) ; hauteur du texte en pixels
If ll <= al And hh <= ah
; Nous avons assez de place pour écrire tout vers l'avant...
Select Just
Case 0
x1 = x + mx
Case #PB_Text_Right
x1 = x + mx + (al - ll)
Case #PB_Text_Center
x1 = x + mx + ((al - ll)/2)
EndSelect
y1 = y + my + ((ah - hh)/2)
DrawText(x1,y1,Txt)
ProcedureReturn
Else
If Deroul
; Nous pourrions avoir besoin de dérouler le texte sur une autre ligne... lors du déroulement nous ne considérons pas la justification (pour l'instant!)
lng = Len(txt)
x1 = x + mx : x2 = x1 + al
y1 = y + my : y2 = y1 + ah
Protected sMot,eMot,wMot, nn, tMot.s, cc.s
wMot = 0 : sMot = 1: eMot = 0
For i=1 To lng
If Mid(txt, i, 1) = " " Or i=lng: eMot = i : EndIf
If eMot > 0 ; nous dessinons ce mot courant
Repeat
tMot = Mid(txt, sMot, eMot-sMot+1)
wMot = TextWidth(tMot)
If x1 + wMot <= x2
x1 = DrawText(x1,y1,tMot)
sMot = eMot + 1: eMot = 0
Else
If wMot <= al
x1 = x + mx ; nous passons à une nouvelle ligne
y1 = y1 + (hh + my)
If (y1+hh) > y2 : Break : EndIf
x1 = DrawText(x1,y1,tMot)
sMot = eMot + 1: eMot = 0
Else
; nous dessinons caractère par caractère
nn = Len(tMot)
For j=1 To nn
cc = Mid(tMot,j,1)
If x1 + TextWidth(cc) <= x2
x1 = DrawText(x1,y1,cc)
sMot = sMot + 1
If j = nn : eMot = 0: EndIf
Else
x1 = x + mx ; nous passons à une nouvelle ligne
y1 = y1 + (hh + my)
Break
EndIf
Next
EndIf
EndIf
If (y1+hh) > y2 : Break : EndIf
Until sMot > eMot
EndIf
If (y1+hh) > y2 : Break : EndIf
Next
Else
x1 = x + mx : x2 = x1 + al
y1 = y + my : y2 = y1 + ah
i = 0
Repeat
i = i + 1
If i > lng : Break : EndIf
l0 = TextWidth(Mid(txt, i, 1))
If x1 + l0 > x2 : Break : EndIf
x1 = DrawText(x1,y1,Mid(txt, i, 1))
ForEver
EndIf
EndIf
EndProcedure
Procedure.i _MonDessinCoche(x,y,l,h, LrgBox, actif, Coche_=#False)
;dessiner une case à cocher /(x,y,l,h) est la zone donnée pour le dessin de la case... suppose un StartDrawing !
Protected ll,hh, x0,y0,xa,ya,xb,yb,xc,yc, CoulFnd = $CD0000
ll = LrgBox : hh = LrgBox
If ll <= l And hh <= h
x0 = x + ((l - ll) / 2)
y0 = y + ((h - hh) / 2)
If actif = #False : CoulFnd = $9F9F9F : EndIf
DrawingMode(#PB_2DDrawing_Default)
Box(x0 ,y0 ,ll ,hh ,CoulFnd)
Box(x0+1,y0+1,ll-2,hh-2,$D4D4D4)
Box(x0+2,y0+2,ll-4,hh-4,$FFFFFF)
;
If Coche_
xb = x0 + (ll / 2) - 1 : yb = y0 + hh - 5
xa = x0 + 4 : ya = yb - xb + xa
xc = x0 + ll - 4 : yc = yb + xb - xc
FrontColor($12A43A)
LineXY(xb,yb ,xa,ya ) : LineXY(xb,yb ,xc,yc )
LineXY(xb,yb-1,xa,ya-1) : LineXY(xb,yb-1,xc,yc-1) ; déplacer par 1
LineXY(xb,yb-2,xa,ya-2) : LineXY(xb,yb-2,xc,yc-2) ; déplacer par 2
EndIf
EndIf
EndProcedure
Procedure.i _MonDessinRadio(x,y,l,h, LrgBox, actif, Coche_=#False)
; dessiner un bouton radio/option /(x,y,L,h) est la zone donnée pour dessiner le bouton radio/option... suppose un StartDrawing!
Protected ll,hh, x0,y0, CoulFnd = $CD0000
ll = LrgBox : hh = LrgBox
If ll <= l And hh <= h
x0 = x + l/2 ;((l - ll) / 2)
y0 = y + h/2 ;((h - hh) / 2)
If actif = #False : CoulFnd = $9F9F9F : EndIf
DrawingMode(#PB_2DDrawing_Default)
Circle(x0, y0, LrgBox/2, CoulFnd)
Circle(x0, y0, LrgBox/2 - 2, $FFFFFF)
If Coche_
FrontColor($12A43A): Circle(x0, y0, 3)
EndIf
EndIf
EndProcedure
Procedure.i _MonDessinComboDeroulant(x,y,l,h, avecFnd=#False)
; dessiner un combo-box-déroulant (x,y,l,h) est la zone donnée pour le dessin .. suppose un StartDrawing!
Protected x0,y0,ll,hh
ll = 7
hh = 4
If ll < l And hh < h
If avecFnd
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(RGB(224, 226, 226)) : FrontColor(RGB(201, 201, 201)) : LinearGradient(x,y,x,y+h/2)
Box(x+3,y+3,l-5,h-5)
EndIf
DrawingMode(#PB_2DDrawing_Default): FrontColor($CD0000)
Line(x,y+4,1,h-8)
x0 = x + (l - ll)/2
y0 = y + (h - hh)/2 - 1
Line(x0 ,y0 ,ll ,1)
Line(x0+1,y0+1,ll-2,1)
Line(x0+2,y0+2,ll-4,1)
Line(x0+3,y0+3,ll-6,1)
EndIf
EndProcedure
;---<<<====>>> coeur
Procedure Dessiner(*monBtn.SMonBouton)
Protected l,h,x,y, l1,h1,gdt, x0, l0, actif
Protected gC0,gC1,lng,tCoul ; détails gradient et couleurs texte
If *monBtn = 0
ProcedureReturn
EndIf
gdt = *monBtn\Gadget
If StartDrawing(CanvasOutput(gdt)) = 0
ProcedureReturn
EndIf
l = GadgetWidth(gdt): h = GadgetHeight(gdt)
; commun à tous les cas
DrawingMode(#PB_2DDrawing_Default) : Box(0,0,l,h,*monBtn\CoulCoin)
actif = #True : lng = 2
Select *monBtn\Etat
Case #Etat_nonActif
actif = #False
gC0 = $B8B8B8: gC1 = Coul_Desactive: lng = 1: tCoul = $C4C4C4
Case #Etat_SourisDedans
;gC0 = $FFFFFF: gC1 = Coul_Dedans: lng = 2: tCoul = $000000
gC1 = Coul_Dedans: lng = 2: tCoul = CoulTxtDedans
gC0 = _MonMelangeCouleurs($FFFFFF, Coul_Dedans, *monBtn\Gradient)
Case #Etat_SourisHors
gC1 = *monBtn\CoulFnd: lng = 2: tCoul = *monBtn\CoulTxt
gC0 = _MonMelangeCouleurs($FFFFFF, *monBtn\CoulFnd, *monBtn\Gradient)
EndSelect
If (*monBtn\Etat = #Etat_ClicSouris) Or ((*monBtn\Type = #Type_Bascule) And *monBtn\Coche_) Or ((*monBtn\Type = #Type_BasculeRadio) And *monBtn\Coche_)
gC1 = Coul_Pousse: gC0 = $FFFFFF: lng = 3: tCoul = CoulTxtPousse
EndIf
FrontColor(gC1)
If *monBtn\Gradient > 0
BackColor(gC0) : LinearGradient(0,0,0,h/lng)
DrawingMode(#PB_2DDrawing_Gradient)
Else
DrawingMode(#PB_2DDrawing_Default)
EndIf
RoundBox(0,0,l,h,*monBtn\Rayon,*monBtn\Rayon)
; décoration et textes
If IsImage(*monBtn\Image)
If *monBtn\FaireTenirImage
DrawImage(ImageID(*monBtn\Image), 4,4,l-8,h-8) ; redimensionner/faire tenir
Else
; taille fixe
DrawingMode(#PB_2DDrawing_AlphaBlend)
l1 = (l - ImageWidth( *monBtn\Image))/2 : If l1 < 0 : l1 = 0 : EndIf
h1 = (h - ImageHeight(*monBtn\Image))/2 : If h1 < 0 : h1 = 0 : EndIf
DrawImage(ImageID(*monBtn\Image), l1, h1)
EndIf
EndIf
Select *monBtn\Type
Case #Type_Normal, #Type_Bascule, #Type_BasculeRadio
If *monBtn\Texte <> ""
DrawingMode(#PB_2DDrawing_Transparent) : FrontColor(tCoul)
If IsFont(*monBtn\Police) : DrawingFont(FontID(*monBtn\Police)) : EndIf
_MonDessinTexte(*monBtn\Texte,0,0,l,h, #Marge_TexteX,#Marge_TexteY, *monBtn\Justif)
EndIf
Case #Type_Coche
_MonDessinCoche(#Marge_TexteX, 0, #Largeur_Coche, h, #Largeur_Coche, actif, *monBtn\Coche_)
If *monBtn\Texte <> ""
DrawingMode(#PB_2DDrawing_Transparent) : FrontColor(tCoul)
If IsFont(*monBtn\Police) : DrawingFont(FontID(*monBtn\Police)) : EndIf
x0 = #Marge_TexteX + #Largeur_Coche
l0 = l - x0
_MonDessinTexte(*monBtn\Texte,x0,0,l0,h, #Marge_TexteX,#Marge_TexteY, *monBtn\Justif)
EndIf
Case #Type_Radio
_MonDessinRadio(#Marge_TexteX, 0, #Largeur_Coche, h, #Largeur_Coche, actif, *monBtn\Coche_)
If *monBtn\Texte <> ""
DrawingMode(#PB_2DDrawing_Transparent) : FrontColor(tCoul)
If IsFont(*monBtn\Police) : DrawingFont(FontID(*monBtn\Police)) : EndIf
x0 = #Marge_TexteX + #Largeur_Coche
l0 = l - x0
_MonDessinTexte(*monBtn\Texte,x0,0,l0,h, #Marge_TexteX,#Marge_TexteY, *monBtn\Justif)
EndIf
Case #Type_Deroulant
_MonDessinComboDeroulant(l-#Largeur_Deroulant, 0, #Largeur_Deroulant, h)
If *monBtn\Texte <> ""
DrawingMode(#PB_2DDrawing_Transparent) : FrontColor(tCoul)
If IsFont(*monBtn\Police) : DrawingFont(FontID(*monBtn\Police)) : EndIf
l0 = l - #Largeur_Deroulant
_MonDessinTexte(*monBtn\Texte,0,0,l0,h, #Marge_TexteX,#Marge_TexteY, *monBtn\Justif)
EndIf
EndSelect
; commun dans tous les cas
If *monBtn\CoulBord >= 0
DrawingMode(#PB_2DDrawing_Outlined)
RoundBox(0,0,l,h,*monBtn\Rayon,*monBtn\Rayon,*monBtn\CoulBord)
EndIf
StopDrawing()
EndProcedure
Procedure.i GereEvenement(Gadget, TpEvnt)
;gère le nouvel événement, met à jour l'état... et retourne True si l'utilisateur clique sur le btn = > nous allons procéder
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
Protected EtatPrv,mx,my,dd, siClique_
If *monBtn = 0 : ProcedureReturn #False : EndIf
If *monBtn\Etat = #Etat_nonActif : ProcedureReturn #False : EndIf
EtatPrv = *monBtn\Etat
Select TpEvnt
Case #PB_EventType_Input
If Chr(GetGadgetAttribute(Gadget, #PB_Canvas_Input)) = " "
*monBtn\Coche_ = Bool(*monBtn\Coche_ XOr #True)
*monBtn\Etat = #Etat_SourisHors
siClique_ = #True ; ceci sera retourné par le traitement
EndIf
Case #PB_EventType_KeyDown
If GetGadgetAttribute(Gadget, #PB_Canvas_Key ) = #PB_Shortcut_Return
*monBtn\Coche_ = Bool(*monBtn\Coche_ XOr #True)
*monBtn\Etat = #Etat_SourisHors
siClique_ = #True ; ceci sera retourné par le traitement
EndIf
Case #PB_EventType_MouseEnter
*monBtn\Etat = #Etat_SourisDedans
Case #PB_EventType_MouseMove ; nous en avons besoin parce que le mouse-up est reçu avant l'éloignement de la souris (mouse leave)
If *monBtn\Etat <> #Etat_ClicSouris
*monBtn\Etat = #Etat_SourisDedans
EndIf
Case #PB_EventType_MouseLeave
*monBtn\Etat = #Etat_SourisHors
Case #PB_EventType_LeftButtonDown
*monBtn\Etat = #Etat_ClicSouris
Case #PB_EventType_LeftButtonUp
mx = GetGadgetAttribute(Gadget, #PB_Canvas_MouseX)
my = GetGadgetAttribute(Gadget, #PB_Canvas_MouseY)
If (mx < GadgetWidth(Gadget)) And (my < GadgetHeight(Gadget)) And (mx >= 0) And (my >= 0)
If (EtatPrv = #Etat_ClicSouris)
siClique_ = #True ; ceci sera retourné par le traitement
;*monBtn\Etat = #Etat_SourisDedans
*monBtn\Etat = #Etat_SourisHors
Select *monBtn\Type
Case #Type_Bascule, #Type_Coche
*monBtn\Coche_ = Bool(*monBtn\Coche_ XOr #True)
Case #Type_Radio, #Type_BasculeRadio
*monBtn\Coche_ = #True
Case #Type_Deroulant
dd = GadgetWidth(Gadget) - mx
If IsMenu(*monBtn\Menu) And (dd < #Largeur_Deroulant)
DisplayPopupMenu(*monBtn\Menu, WindowID(GetActiveWindow()))
EndIf
EndSelect
EndIf
EndIf
Default
ProcedureReturn #False
EndSelect
; nous dessinons si besoin (nouvel état different) ou vérification changée
If siClique_ Or (EtatPrv <> *monBtn\Etat)
Dessiner(*monBtn)
EndIf
; siClique_ = True => un clic a été reçu par ce bouton, prêt pour le procédé
ProcedureReturn siClique_
EndProcedure
Procedure.i GestionEvenements()
If GereEvenement(EventGadget(), EventType())
Protected *monBtn.SMonBouton = GetGadgetData(EventGadget())
;Debug " Clic sur " + *monBtn\Texte
If *monBtn\AuClic
*monBtn\AuClic()
EndIf
EndIf
EndProcedure
Procedure.i Clic(Gadget)
; simule un clic, peut être appelé par code
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
If *monBtn
If *monBtn\AuClic : *monBtn\AuClic() : EndIf
EndIf
EndProcedure
Procedure.i ReinitialisationModele()
With ML_BTN
\Gadget = -1
\Type = #Type_Normal
\CoulFnd = $00EED3B9 ;$00ED9667
\CoulCoin = $FFFFFF
\CoulBord = $FFFFFF
\CoulTxt = $000000
\Justif = #PB_Text_Center
\Gradient = 60
\Rayon = 7
\Police = -1
\Image = -1
\FaireTenirImage = 0
\Menu = -1
\Texte = "Nouveau Bouton"
\Coche_ = #False
\Etat = #Etat_SourisHors
EndWith
EndProcedure
Procedure.i DefinirModele(Propriete, Valeur)
With ML_BTN
; réviser le modèle par défaut
Select Propriete
Case #Prop_CoulFnd : \CoulFnd = Valeur
Case #Prop_CoulFndExt : \CoulCoin = Valeur
Case #Prop_CoulBord : \CoulBord = Valeur
Case #Prop_CoulTxt : \CoulTxt = Valeur
Case #Prop_Police : \Police = Valeur
Case #Prop_Rayon : \Rayon = Valeur
Case #Prop_Justif : \Justif = Valeur
Case #Prop_Type : \Type = Valeur
Case #Prop_Image : \Image = Valeur
Case #Prop_FaireTenirImage : \FaireTenirImage = Valeur
Case #Prop_Menu : \Menu = Valeur
Case #Prop_Etat : \Etat = Valeur
Case #Prop_Coche_ : \Coche_ = Valeur
Case #Prop_Gradient : \Gradient = Valeur
;If Valeur > 100 : Valeur = 100 : EndIf
;If Valeur < 0 : Valeur = 0 : EndIf
Default
ProcedureReturn
EndSelect
EndWith
EndProcedure
Procedure.i DefinirPropriete(Gadget, Propriete, Valeur)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
Select Propriete
Case #Prop_CoulFnd : *monBtn\CoulFnd = Valeur
Case #Prop_CoulFndExt : *monBtn\CoulCoin = Valeur
Case #Prop_CoulBord : *monBtn\CoulBord = Valeur
Case #Prop_CoulTxt : *monBtn\CoulTxt = Valeur
Case #Prop_Police : *monBtn\Police = Valeur
Case #Prop_Rayon : *monBtn\Rayon = Valeur
Case #Prop_Justif : *monBtn\Justif = Valeur
Case #Prop_Type : *monBtn\Type = Valeur
Case #Prop_Image : *monBtn\Image = Valeur
Case #Prop_FaireTenirImage : *monBtn\FaireTenirImage = Bool(Valeur)
Case #Prop_Menu : *monBtn\Menu = Valeur
Case #Prop_Etat : *monBtn\Etat = Valeur
Case #Prop_Coche_ : *monBtn\Coche_ = Valeur
Case #Prop_Gradient : *monBtn\Gradient = Valeur
Case #Prop_AuClic : *monBtn\AuClic = Valeur
Default : ProcedureReturn ;pas besoin de dessiner
EndSelect
DefinirModele(Propriete, Valeur)
Dessiner(*monBtn)
EndProcedure
Procedure.i ObtenirPropriete(Gadget, Propriete)
Protected Valeur = -1, *monBtn.SMonBouton = GetGadgetData(Gadget)
Select Propriete
Case #Prop_CoulFnd : Valeur = *monBtn\CoulFnd
Case #Prop_CoulFndExt : Valeur = *monBtn\CoulCoin
Case #Prop_CoulBord : Valeur = *monBtn\CoulBord
Case #Prop_CoulTxt : Valeur = *monBtn\CoulTxt
Case #Prop_Police : Valeur = *monBtn\Police
Case #Prop_Rayon : Valeur = *monBtn\Rayon
Case #Prop_Justif : Valeur = *monBtn\Justif
Case #Prop_Type : Valeur = *monBtn\Type
Case #Prop_Image : Valeur = *monBtn\Image
Case #Prop_FaireTenirImage : Valeur = *monBtn\FaireTenirImage
Case #Prop_Menu : Valeur = *monBtn\Menu
Case #Prop_Etat : Valeur = *monBtn\Etat
Case #Prop_Coche_ : Valeur = *monBtn\Coche_
Case #Prop_Gradient : Valeur = *monBtn\Gradient
Case #Prop_AuClic : Valeur = *monBtn\AuClic
EndSelect
ProcedureReturn Valeur
EndProcedure
Procedure.i DefinirTexte(Gadget, Texte.s)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
*monBtn\Texte = Texte
Dessiner(*monBtn)
EndProcedure
Procedure.s ObtenirTexte(Gadget)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
ProcedureReturn *monBtn\Texte
EndProcedure
Procedure.i Verifier(Gadget, Etat = #True)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
If *monBtn = 0
ProcedureReturn
EndIf
If *monBtn\Type > #Type_Deroulant
*monBtn\Coche_ = Etat
Dessiner(*monBtn)
EndIf
EndProcedure
Procedure.i Activer(Gadget, Etat = #True)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
If *monBtn = 0
ProcedureReturn
EndIf
If Etat
*monBtn\Etat = #Etat_SourisHors
Else
*monBtn\Etat = #Etat_nonActif
EndIf
DisableGadget(Gadget, Bool(Not Etat))
Dessiner(*monBtn)
EndProcedure
Procedure.i SiCoche_(Gadget)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
If *monBtn = 0
ProcedureReturn #False
EndIf
If *monBtn\Type > #Type_Deroulant And *monBtn\Coche_
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i Siactif(Gadget)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
If *monBtn = 0
ProcedureReturn #False
EndIf
If *monBtn\Etat <> #Etat_nonActif
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i Liberer(Gadget)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
If *monBtn
UnbindGadgetEvent(Gadget, @GestionEvenements())
ClearStructure(*monBtn, SMonBouton)
FreeMemory(*monBtn)
EndIf
FreeGadget(Gadget)
EndProcedure
Procedure.i Redimensionner(Gadget, x, y, Largeur, Hauteur)
Protected *monBtn.SMonBouton = GetGadgetData(Gadget)
ResizeGadget(Gadget, x, y, Largeur, Hauteur)
Dessiner(*monBtn)
EndProcedure
Procedure.i Creer(Gadget, x, y, l, h, Texte.s, Conseil.s="")
; nouveau bouton selon les paramètres par défaut dans le modèle quel qu'il soit
Protected Bouton, *monBtn.SMonBouton
Bouton = CanvasGadget(Gadget, x, y, l, h, #PB_Canvas_Keyboard);|#PB_Canvas_DrawFocus)
If Bouton
If Gadget <> #PB_Any
Bouton = Gadget
EndIf
*monBtn = AllocateMemory(SizeOf(SMonBouton))
InitializeStructure(*monBtn, SMonBouton)
CopyStructure(@ML_BTN, *monBtn, SMonBouton)
*monBtn\Gadget = Bouton
*monBtn\Coche_ = #False
*monBtn\Etat = #Etat_SourisHors
*monBtn\Texte = Texte
*monBtn\AuClic = 0
SetGadgetData(Bouton, *monBtn)
SetGadgetAttribute(Bouton,#PB_Canvas_Cursor,#PB_Cursor_Hand)
GadgetToolTip(Bouton, Conseil)
BindGadgetEvent(Bouton, @GestionEvenements())
Dessiner(*monBtn)
EndIf
ProcedureReturn Bouton
EndProcedure
; appeler ReinitialisationModele()
ReinitialisationModele()
EndModule
;---<<<====>>> exemples et cas prédéterminés exceptionnellement
CompilerIf #PB_Compiler_IsMainFile
UsePNGImageDecoder()
UseModule MonBouton
Procedure.i MonBouton_Deroulant(Gadget, x, y, Largeur, Hauteur, Menu, Texte.s)
; bouton déroulant
DefinirModele(#Prop_Type, #Type_Deroulant)
DefinirModele(#Prop_Justif, #PB_Text_Center)
DefinirModele(#Prop_Menu, Menu)
ProcedureReturn Creer(Gadget, x, y, Largeur, Hauteur, Texte)
EndProcedure
Procedure.i MonBouton_Bascule(Gadget, x, y, Largeur, Hauteur, Texte.s)
; bouton bascule
DefinirModele(#Prop_Type, #Type_Bascule)
DefinirModele(#Prop_Justif, #PB_Text_Center)
ProcedureReturn Creer(Gadget, x, y, Largeur, Hauteur,Texte)
EndProcedure
Procedure.i MonBouton_Coche(Gadget, x, y, Largeur, Hauteur, Texte.s)
; bouton à cocher
DefinirModele(#Prop_Justif, 0)
DefinirModele(#Prop_Type, #Type_Coche)
DefinirModele(#Prop_CoulFnd, #Red)
ProcedureReturn Creer(Gadget, x, y, Largeur, Hauteur,Texte)
EndProcedure
Procedure.i MonBouton_Option(Gadget, x, y, Largeur, Hauteur, Texte.s)
; bouton option
DefinirModele(#Prop_Justif, 0)
DefinirModele(#Prop_Type, #Type_Radio)
ProcedureReturn Creer(Gadget, x, y, Largeur, Hauteur,Texte)
EndProcedure
Procedure.i MonBouton_Plat(Gadget, x, y, Largeur, Hauteur, Texte.s)
; bouton plat carré sans rayon ni gradient
DefinirModele(#Prop_Justif, 0)
DefinirModele(#Prop_Gradient, 0)
DefinirModele(#Prop_Rayon, 0)
DefinirModele(#Prop_Type, #Type_Normal)
ProcedureReturn Creer(Gadget, x, y, Largeur, Hauteur,Texte)
EndProcedure
Enumeration
#MenuItem_1
#MenuItem_2
#MenuItem_3
EndEnumeration
Define Btn1, Btn2, Btn3, Btn4, Btn5, Btn6, Btn7, mnu, gdt,img
Procedure AuClic_Btn1()
MessageRequester("Au Clic","hé, je suis le bouton 1 et vous m'avez pressé!")
EndProcedure
If OpenWindow(0, 0, 0, 420, 360, "Bouton Canvas", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
SetWindowColor(0,$FFFFFF)
mnu = CreatePopupMenu(#PB_Any)
If mnu
MenuItem(#MenuItem_1, "Elément 1")
MenuItem(#MenuItem_2, "Elément 2")
MenuItem(#MenuItem_3, "Elément 3")
EndIf
Btn1 = Creer(#PB_Any, 10, 10, 200, 30,"Bouton 1", "bouton normal")
Btn2 = MonBouton_Coche(#PB_Any, 10, 50, 350, 60,"Une GRANDE boîte à cocher")
Btn3 = MonBouton_Option(#PB_Any, 10,120, 200, 30,"Option Désactivée")
Btn4 = MonBouton_Bascule(#PB_Any, 10,160, 220, 30,"Option texte aligné à droite")
Btn5 = MonBouton_Bascule(#PB_Any, 10,200, 200, 30,"Bascule ...")
Btn6 = MonBouton_Deroulant(#PB_Any, 10,240, 200, 30, mnu,"Déroulant...")
DefinirModele(#Prop_CoulFnd, $AA9C83)
DefinirModele(#Prop_Rayon, 0)
DefinirModele(#Prop_CoulBord, -1)
Btn7 = Creer(#PB_Any, 10,280, 220, 30, "") ; bouton image
Btn8 = MonBouton_Plat(#PB_Any, 10, 320, 220, 30, "Et pourquoi pas un bouton plat ?")
DefinirPropriete(Btn1, #Prop_Rayon,15)
; attacher une procédure à l'événement AuClic
DefinirPropriete(Btn1, #Prop_AuClic, @AuClic_Btn1())
DefinirPropriete(Btn2, #Prop_CoulBord, RGB(0, 0, 255))
DefinirPropriete(Btn2, #Prop_CoulFnd, RGB(84, 227, 209))
DefinirPropriete(Btn2, #Prop_Justif, #PB_Text_Center)
DefinirPropriete(Btn2, #Prop_Police, LoadFont(#PB_Any, "Verdana", 14, #PB_Font_Bold))
Activer(Btn3, #False)
DefinirPropriete(Btn3, #Prop_Coche_, #True)
DefinirPropriete(Btn4, #Prop_Type, #Type_Radio) ; modification du type par la suite ...
DefinirPropriete(Btn4, #Prop_Coche_, #True)
DefinirPropriete(Btn4, #Prop_Justif, #PB_Text_Right)
DefinirPropriete(Btn4, #Prop_CoulTxt, $FFFFFF)
DefinirPropriete(Btn4, #Prop_Gradient,90)
DefinirPropriete(Btn6, #Prop_CoulFnd, $9AD968)
DefinirPropriete(Btn6, #Prop_CoulBord, $72C431)
DefinirPropriete(Btn6, #Prop_Rayon, 0)
img = LoadImage(#PB_Any, #PB_Compiler_Home + "Examples/3D/Data/PureBasic3DLogo.png")
DefinirPropriete(Btn7, #Prop_Type, #Type_Normal)
DefinirPropriete(Btn7, #Prop_Image, img)
DefinirPropriete(Btn7, #Prop_FaireTenirImage, #True)
DefinirPropriete(Btn8, #Prop_Type, #Type_Bascule)
DefinirPropriete(Btn8, #Prop_CoulFnd, $50FFFF)
DefinirPropriete(Btn8, #Prop_CoulTxt, $FF0000)
Repeat
Select WaitWindowEvent()
Case #PB_Event_SizeWindow
Redimensionner(btn2, #PB_Ignore,#PB_Ignore, WindowWidth(0) - 220, #PB_Ignore)
Redimensionner(btn4, #PB_Ignore,#PB_Ignore, WindowWidth(0) - 220, #PB_Ignore)
Redimensionner(btn7, #PB_Ignore,#PB_Ignore, WindowWidth(0) - 220, #PB_Ignore)
Case #PB_Event_Menu
Select EventMenu()
Case #MenuItem_1 : Debug " Article menu 1"
Case #MenuItem_2 : Debug " Article menu 2"
Case #MenuItem_3 : Debug " Article menu 3"
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
EndIf
CompilerEndIf
(j'ai corrigé)