RollOver effects

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

RollOver effects

Message par Jacobus »

Hello, une astuce pour obtenir des boutons images activés par survol de la souris, donnant un effet sympa. Dri nous avait concocté une technique pour border une image en cliquant dessus - Image toggle - j'ai donc repris son code pour l'assembler avec un mouseOver et ça donne ça.

Code : Tout sélectionner

; RollOver effects par Jacobus 
; Astuce rendue possible grâce à DrDri et son Image Toggle 
; 
Enumeration
#win
#Btn_1
#Txt_Btn_1
#Btn_2
#Txt_Btn_2
#texto
#Statusbar
EndEnumeration

Global MyHand,Start,Image0, Image1,Font0
MyHand = LoadCursor_(0, #IDC_HAND);curseur main
Start  = LoadCursor_(0, #IDC_APPSTARTING);curseur démarrage application
Image0 = CatchImage(0, ?Image0)
Image1 = CatchImage(1, ?Image1)
Font0  = LoadFont(0, "Verdana", 9,#PB_Font_Bold|#PB_Font_HighQuality)
DataSection 
Image0 : IncludeBinary "Images\Image0.ico"; <***INDIQUEZ LE CHEMIN DE VOS ICONES OU IMAGES***
Image1 : IncludeBinary "Images\Image1.ico"
EndDataSection

Procedure   IsMouseOver(wnd) 
  GetWindowRect_ (wnd,re.RECT) 
  re\left = re\left 
  re\top = re\top 
  re\right = re\right 
  re\bottom = re\bottom 
  GetCursorPos_ (pt.POINT) 
  ProcedureReturn PtInRect_ (re,pt\x,pt\y) 
EndProcedure 

Macro ImageGadgetBorderWidth() 
  GetSystemMetrics_(#SM_CXEDGE) 
EndMacro 

Macro ImageGadgetBorderHeight() 
  GetSystemMetrics_(#SM_CYEDGE) 
EndMacro 

Procedure.l SetImageGadgetBorder(Gadget.l, State.l) 
  Protected Set.l = #False, GadgetID.l, Style.l 
  Protected Width.l, Height.l, Change.l = #False 
  
  GadgetID = GadgetID(Gadget) 
  
  If GadgetID 
    Style = GetWindowLong_(GadgetID, #GWL_EXSTYLE) 
    
    Width  = GadgetWidth(Gadget) 
    Height = GadgetHeight(Gadget) 
    
    If State 
      If Not Style & #PB_Image_Border 
        Width  + ImageGadgetBorderWidth()  * 2 
        Height + ImageGadgetBorderHeight() * 2 
        Style |  #PB_Image_Border 
        Change = #True 
      EndIf 
    Else 
      If Style & #PB_Image_Border 
        Width  - ImageGadgetBorderWidth()  * 2 
        Height - ImageGadgetBorderHeight() * 2 
        Style & ~#PB_Image_Border 
        Change = #True 
      EndIf 
    EndIf 
    
    If Change 
      SetWindowLong_(GadgetID, #GWL_EXSTYLE, Style) 
      SetWindowPos_(GadgetID, 0, 0, 0, Width, Height, #SWP_NOMOVE | #SWP_FRAMECHANGED) 
    EndIf 
    
    Set = #True 
  EndIf 
  
  ProcedureReturn Set 
EndProcedure 



OpenWindow(#win,0,0,240,280,"RollOver Buttons Example",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(#win)) 
SetWindowColor(#win,RGB(157, 173, 206))
 
    btn1=ImageGadget(#Btn_1,85,10,100,60,Image1);on se sert d'une image comme bouton
    TextGadget(#Txt_Btn_1,5,70,220,30,"Button Number 1"+Chr(13)+"Ce bouton vous mène à rien",#PB_Text_Center)
    SetGadgetColor(#Txt_Btn_1,#PB_Gadget_FrontColor,RGB(255,255,255))
    SetGadgetColor(#Txt_Btn_1,#PB_Gadget_BackColor,RGB(157, 173, 206))
        
    btn2=ImageGadget(#Btn_2,85,105,100,60,Image0);ImageGadget ajuste sa taille à celle de l'image
    TextGadget(#Txt_Btn_2,5,165,220,30,"Button Number 2"+Chr(13)+"Celui-ci non plus d'ailleurs",#PB_Text_Center)
    SetGadgetColor(#Txt_Btn_2,#PB_Gadget_FrontColor,RGB(255,255,255))
    SetGadgetColor(#Txt_Btn_2,#PB_Gadget_BackColor,RGB(157, 173, 206))
    
    Texto=TextGadget(#texto,5,210,220,30,"Mais vous pourriez leur donner une destination",#PB_Text_Center)
    SetGadgetColor(#texto,#PB_Gadget_FrontColor,RGB(255,255,255))
    SetGadgetColor(#texto,#PB_Gadget_BackColor,RGB(157, 173, 206))

;-STATUSBAR 
If CreateStatusBar(#Statusbar, WindowID(#win))
    AddStatusBarField(WindowWidth(#win)/2)
    AddStatusBarField(WindowWidth(#win)/2)  
    StatusBarText(#Statusbar, 0, "RollOver effects",  #PB_StatusBar_Raised)
    StatusBarText(#Statusbar, 1, "PureBasic Users"+Chr(169),  #PB_StatusBar_Raised|#PB_StatusBar_Right)
EndIf

Repeat 
 Event = WaitWindowEvent()
  Select Event
  
  ;ci-dessous quelques exemples, mais d'autres possibilités sont réalisables
  Case #WM_MOUSEMOVE 
    If IsMouseOver(btn1):SetCursor_(MyHand)
      StatusBarText(#Statusbar, 0, "Bouton 1 survolé")
      SetImageGadgetBorder(#Btn_1, #True)
      SetImageGadgetBorder(#Btn_2, #False) 
      SetGadgetFont(#Txt_Btn_1,Font0)
      SetGadgetFont(#Txt_Btn_2,#PB_Default)
      SetGadgetFont(#texto,#PB_Default)
    ElseIf IsMouseOver(btn2):SetCursor_(MyHand)
      StatusBarText(#Statusbar, 0, "Bouton 2 survolé")
      SetImageGadgetBorder(#Btn_1, #False)  
      SetImageGadgetBorder(#Btn_2, #True)
      SetGadgetFont(#Txt_Btn_1,#PB_Default)
      SetGadgetFont(#Txt_Btn_2,Font0)
      SetGadgetFont(#texto,#PB_Default)
    ElseIf IsMouseOver(Texto):SetCursor_(Start)
      StatusBarText(#Statusbar, 0, "Votre texto activé")
      SetImageGadgetBorder(#Btn_1, #False)  
      SetImageGadgetBorder(#Btn_2, #False)
      SetGadgetFont(#Txt_Btn_1,#PB_Default)
      SetGadgetFont(#Txt_Btn_2,#PB_Default)
      SetGadgetFont(#texto,Font0)  
    Else 
      StatusBarText(#Statusbar, 0, "RollOver effects")
      SetImageGadgetBorder(#Btn_1, #False)  
      SetImageGadgetBorder(#Btn_2, #False)
      SetGadgetFont(#Txt_Btn_1,#PB_Default)
      SetGadgetFont(#Txt_Btn_2,#PB_Default)
      SetGadgetFont(#texto,#PB_Default)
    EndIf 
    
  Case #PB_Event_Gadget 
     Select EventGadget()
     
     Case #Btn_1
       Select EventType() 
           Case #PB_EventType_LeftClick
             MessageRequester("BOUTON 1","Pas de programme de destination",#IDI_HAND)
       EndSelect 
     
     
     Case #Btn_2
       Select EventType() 
         Case #PB_EventType_LeftClick
           MessageRequester("BOUTON 2","Pas de programme de destination",#IDI_APPLICATION)
       EndSelect
      
     EndSelect 
   EndSelect 
Until Event = #PB_Event_CloseWindow 
End
Sympa non ? :P

[Edit] défaut corrigé concernant l'event des boutons.
Dernière modification par Jacobus le dim. 08/oct./2006 11:17, modifié 2 fois.
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Un autre problème est le scintillement du au fait que le code réactualise toujours le mouse over lorsque le curseur se balade au dessus de l'image.
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

Oui ce scintillement n'est perceptible que sur les textes, ce qui est gênant en effet, mais si on utilise uniquement des images en boutons cela ne paraît pas.

grâce à EventType() le problème du double requester dans l'event est corrigé, reste plus que le scintillement qui se produit dès que l'on bouge la souris.
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

J'ai ajouté une variable globale pour récupérer la font par défaut après la création des gadget (j'ai fait des tests, c'est bien la même pour tous les textgadget.

Ensuite j'ai modifié dans la boucle mousemove pour ne réécrire les police que si ce n'est pas celle voulue. On a plus le problème de scintillement (je ne le vois plus sur ma bécane) qui est du à une réécriture du texte.

Code : Tout sélectionner

; RollOver effects par Jacobus
; Astuce rendue possible grâce à DrDri et son Image Toggle
;
Enumeration
#win
#Btn_1
#Txt_Btn_1
#Btn_2
#Txt_Btn_2
#texto
#Statusbar
EndEnumeration

Global MyHand,Start,Image0, Image1,Font0
MyHand = LoadCursor_(0, #IDC_HAND);curseur main
Start  = LoadCursor_(0, #IDC_APPSTARTING);curseur démarrage application
Image0 = CatchImage(0, ?Image0)
Image1 = CatchImage(1, ?Image1)
Font0  = LoadFont(0, "Verdana", 9,#PB_Font_Bold|#PB_Font_HighQuality)
DataSection
Image0 : IncludeBinary "aqua1s_48_48_XP.ico"; <***INDIQUEZ LE CHEMIN DE VOS ICONES OU IMAGES***
Image1 : IncludeBinary "smiley_smile.ico"
EndDataSection

Procedure   IsMouseOver(wnd)
  GetWindowRect_ (wnd,re.RECT)
  re\left = re\left
  re\top = re\top
  re\right = re\right
  re\bottom = re\bottom
  GetCursorPos_ (pt.POINT)
  ProcedureReturn PtInRect_ (re,pt\x,pt\y)
EndProcedure

Macro ImageGadgetBorderWidth()
  GetSystemMetrics_(#SM_CXEDGE)
EndMacro

Macro ImageGadgetBorderHeight()
  GetSystemMetrics_(#SM_CYEDGE)
EndMacro

Procedure.l SetImageGadgetBorder(Gadget.l, State.l)
  Protected Set.l = #False, GadgetID.l, Style.l
  Protected Width.l, Height.l, Change.l = #False
 
  GadgetID = GadgetID(Gadget)
 
  If GadgetID
    Style = GetWindowLong_(GadgetID, #GWL_EXSTYLE)
   
    Width  = GadgetWidth(Gadget)
    Height = GadgetHeight(Gadget)
   
    If State
      If Not Style & #PB_Image_Border
        Width  + ImageGadgetBorderWidth()  * 2
        Height + ImageGadgetBorderHeight() * 2
        Style |  #PB_Image_Border
        Change = #True
      EndIf
    Else
      If Style & #PB_Image_Border
        Width  - ImageGadgetBorderWidth()  * 2
        Height - ImageGadgetBorderHeight() * 2
        Style & ~#PB_Image_Border
        Change = #True
      EndIf
    EndIf
   
    If Change
      SetWindowLong_(GadgetID, #GWL_EXSTYLE, Style)
      SetWindowPos_(GadgetID, 0, 0, 0, Width, Height, #SWP_NOMOVE | #SWP_FRAMECHANGED)
    EndIf
   
    Set = #True
  EndIf
 
  ProcedureReturn Set
EndProcedure


Global FontParDefaut.l

OpenWindow(#win,0,0,240,280,"RollOver Buttons Example",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(#win))
SetWindowColor(#win,RGB(157, 173, 206))
 
    btn1=ImageGadget(#Btn_1,85,10,100,60,Image1);on se sert d'une image comme bouton
    TextGadget(#Txt_Btn_1,5,70,220,30,"Button Number 1"+Chr(13)+"Ce bouton vous mène à rien",#PB_Text_Center)
    SetGadgetColor(#Txt_Btn_1,#PB_Gadget_FrontColor,RGB(255,255,255))
    SetGadgetColor(#Txt_Btn_1,#PB_Gadget_BackColor,RGB(157, 173, 206))
       
    btn2=ImageGadget(#Btn_2,85,105,100,60,Image0);ImageGadget ajuste sa taille à celle de l'image
    TextGadget(#Txt_Btn_2,5,165,220,30,"Button Number 2"+Chr(13)+"Celui-ci non plus d'ailleurs",#PB_Text_Center)
    SetGadgetColor(#Txt_Btn_2,#PB_Gadget_FrontColor,RGB(255,255,255))
    SetGadgetColor(#Txt_Btn_2,#PB_Gadget_BackColor,RGB(157, 173, 206))
   
    Texto=TextGadget(#texto,5,210,220,30,"Mais vous pourriez leur donner une destination",#PB_Text_Center)
    SetGadgetColor(#texto,#PB_Gadget_FrontColor,RGB(255,255,255))
    SetGadgetColor(#texto,#PB_Gadget_BackColor,RGB(157, 173, 206))

    FontParDefaut = GetGadgetFont(#Txt_Btn_1)
    
;-STATUSBAR
If CreateStatusBar(#Statusbar, WindowID(#win))
    AddStatusBarField(WindowWidth(#win)/2)
    AddStatusBarField(WindowWidth(#win)/2) 
    StatusBarText(#Statusbar, 0, "RollOver effects",  #PB_StatusBar_Raised)
    StatusBarText(#Statusbar, 1, "PureBasic Users"+Chr(169),  #PB_StatusBar_Raised|#PB_StatusBar_Right)
EndIf

Repeat
 Event = WaitWindowEvent()
  Select Event
 
  ;ci-dessous quelques exemples, mais d'autres possibilités sont réalisables
  Case #WM_MOUSEMOVE
    If IsMouseOver(btn1):SetCursor_(MyHand)
      StatusBarText(#Statusbar, 0, "Bouton 1 survolé")
      SetImageGadgetBorder(#Btn_1, #True)
      SetImageGadgetBorder(#Btn_2, #False)
      If GetGadgetFont(#Txt_Btn_1) <> Font0
         SetGadgetFont(#Txt_Btn_1,Font0)
      EndIf
      If GetGadgetFont(#Txt_Btn_2) <> FontParDefaut
         SetGadgetFont(#Txt_Btn_2,#PB_Default)
      EndIf
      If GetGadgetFont(#texto) <> FontParDefaut
        SetGadgetFont(#texto,#PB_Default)
      EndIf
    ElseIf IsMouseOver(btn2):SetCursor_(MyHand)
      StatusBarText(#Statusbar, 0, "Bouton 2 survolé")
      SetImageGadgetBorder(#Btn_1, #False) 
      SetImageGadgetBorder(#Btn_2, #True)
      If GetGadgetFont(#Txt_Btn_1) <> FontParDefaut
         SetGadgetFont(#Txt_Btn_1,#PB_Default)
      EndIf
      If GetGadgetFont(#Txt_Btn_2) <> Font0
         SetGadgetFont(#Txt_Btn_2,Font0)
      EndIf
      If GetGadgetFont(#texto) <> FontParDefaut
        SetGadgetFont(#texto,#PB_Default)
      EndIf
    ElseIf IsMouseOver(Texto):SetCursor_(Start)
      StatusBarText(#Statusbar, 0, "Votre texto activé")
      SetImageGadgetBorder(#Btn_1, #False) 
      SetImageGadgetBorder(#Btn_2, #False)
      If GetGadgetFont(#Txt_Btn_1) <> FontParDefaut
         SetGadgetFont(#Txt_Btn_1,#PB_Default)
      EndIf
      If GetGadgetFont(#Txt_Btn_2) <> FontParDefaut
         SetGadgetFont(#Txt_Btn_2,#PB_Default)
      EndIf
      If GetGadgetFont(#texto) <> Font0
         SetGadgetFont(#texto,Font0) 
      EndIf
    Else
      StatusBarText(#Statusbar, 0, "RollOver effects")
      SetImageGadgetBorder(#Btn_1, #False) 
      SetImageGadgetBorder(#Btn_2, #False)
      If GetGadgetFont(#Txt_Btn_1) <> FontParDefaut
         SetGadgetFont(#Txt_Btn_1,#PB_Default)
      EndIf
      If GetGadgetFont(#Txt_Btn_2) <> FontParDefaut
         SetGadgetFont(#Txt_Btn_2,#PB_Default)
      EndIf
      If GetGadgetFont(#texto) <> FontParDefaut
        SetGadgetFont(#texto,#PB_Default)
      EndIf
    EndIf
   
  Case #PB_Event_Gadget
     Select EventGadget()
     
     Case #Btn_1
       Select EventType()
           Case #PB_EventType_LeftClick
             MessageRequester("BOUTON 1","Pas de programme de destination",#IDI_HAND)
       EndSelect
     
     
     Case #Btn_2
       Select EventType()
         Case #PB_EventType_LeftClick
           MessageRequester("BOUTON 2","Pas de programme de destination",#IDI_APPLICATION)
       EndSelect
     
     EndSelect
   EndSelect
Until Event = #PB_Event_CloseWindow
End 
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Il reste le défaut typique de cette façon de faire, c'est à dire que le mouse over reste effectif si l'on passe de l'image vers une autre fenêtre n'ayant rien avoir avec l'application.
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Nico, tu es sous Win98 parceque je n'ai pas ce problème sous XP

Peut-être détecter le passage sur la zone non client de la fenêtre pour désactiver le mode survol.
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

content que mes codes servent ^^
sinon c'est cruel d'obliger l'utilisateur à choisir ses images

avec cette modif ca marche nickel ^^

Code : Tout sélectionner

Image0 = LoadIcon_(0, #IDI_ASTERISK)
Image1 = LoadIcon_(0, #IDI_EXCLAMATION)
Dri ;)
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

sinon c'est cruel d'obliger l'utilisateur à choisir ses images
:lol: j'ai eu la flemme de les convertir en data...


@Denis Nickel! :D
Dernière modification par Jacobus le dim. 08/oct./2006 15:02, modifié 1 fois.
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Non je suis sous XP!

C'est le même problème que j'essayais de t'expliquer pour ton menu.

Image
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

J'ai pas compris dans ta fonction :

Code : Tout sélectionner

Procedure   IsMouseOver(wnd)
  GetWindowRect_ (wnd,re.RECT)
  
  ;Ces quoi ces 4 lignes ????
  re\left = re\left ;ici
  re\top = re\top ;ici
  re\right = re\right ;ici
  re\bottom = re\bottom ;et ici
  
  GetCursorPos_ (pt.POINT)
  ProcedureReturn PtInRect_ (re,pt\x,pt\y)
EndProcedure 
Dri
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

@nico, Je constate aussi ce que tu dis mais je ne lui trouve pas de conséquence étant donné qu'il suffit de bouger la souris pour rectifier. A la limite si le bouton te déclenche l'ouverture d'une autre fenêtre, ça te permet de voirquel bouton tu as cliqué en dernier lieu. mais c'est peut-être un bug à corriger...
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

Dr. Dri a écrit :J'ai pas compris dans ta fonction :

Code : Tout sélectionner

Procedure   IsMouseOver(wnd)
  GetWindowRect_ (wnd,re.RECT)
  
  ;Ces quoi ces 4 lignes ????
  re\left = re\left ;ici
  re\top = re\top ;ici
  re\right = re\right ;ici
  re\bottom = re\bottom ;et ici
  
  GetCursorPos_ (pt.POINT)
  ProcedureReturn PtInRect_ (re,pt\x,pt\y)
EndProcedure 
Dri
ce n'est pas ma fonction (je l'ai repris sur un code récent de progi84 pour son splitter), c'est pas utile en l'occurence.

comme ça c'est suffisant :

Code : Tout sélectionner

Procedure   IsMouseOver(hgadget) 
  GetWindowRect_ (hgadget,re.RECT) 
  GetCursorPos_ (pt.POINT) 
  ProcedureReturn PtInRect_ (re,pt\x,pt\y) 
EndProcedure
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

nico a écrit :Non je suis sous XP!

C'est le même problème que j'essayais de t'expliquer pour ton menu.

Image
Pour les menus je suis arrivé à corriger et à obtenir le même comportement que sous XP (ca fait quelques mois) avec plusieurs messages.

Pour Le code de Jacobus, faut chercher dans les événements, il y en a bien un qui doit correspondre au changement de fenêtre (peut-être un message indiquant la modif de l'ordre Z
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

J'ai ajouté deux procédures, une qui libère la souris si on va sur une autre application lancée dans la boucle et l'autre qui ré-initialise simplement. Ainsi l'effet relevé par nico disparaît.

Code : Tout sélectionner

; RollOver effects par Jacobus 
; Astuce rendue possible grâce à DrDri et son Image Toggle 
; 
Enumeration 
#win 
#Btn_1 
#Txt_Btn_1 
#Btn_2 
#Txt_Btn_2 
#texto 
#Statusbar 
EndEnumeration 

Global MyHand,Start,Image0, Image1,Font0 
MyHand = LoadCursor_(0, #IDC_HAND);curseur main 
Start  = LoadCursor_(0, #IDC_APPSTARTING);curseur démarrage application 
Image0 = LoadIcon_(0, #IDI_ASTERISK) 
Image1 = LoadIcon_(0, #IDI_EXCLAMATION)
Font0  = LoadFont(0, "Verdana", 9,#PB_Font_Bold|#PB_Font_HighQuality) 

Procedure   IsMouseOver(hgadget) 
  GetWindowRect_ (hgadget,re.RECT) 
  GetCursorPos_ (pt.POINT)  
  ProcedureReturn PtInRect_ (re,pt\x,pt\y) 
EndProcedure

Macro ImageGadgetBorderWidth() 
  GetSystemMetrics_(#SM_CXEDGE) 
EndMacro 

Macro ImageGadgetBorderHeight() 
  GetSystemMetrics_(#SM_CYEDGE) 
EndMacro 

Procedure.l SetImageGadgetBorder(Gadget.l, State.l) 
  Protected Set.l = #False, GadgetID.l, Style.l 
  Protected Width.l, Height.l, Change.l = #False 
  
  GadgetID = GadgetID(Gadget) 
  
  If GadgetID 
    Style = GetWindowLong_(GadgetID, #GWL_EXSTYLE) 
    
    Width  = GadgetWidth(Gadget) 
    Height = GadgetHeight(Gadget) 
    
    If State 
      If Not Style & #PB_Image_Border 
        Width  + ImageGadgetBorderWidth()  * 2 
        Height + ImageGadgetBorderHeight() * 2 
        Style |  #PB_Image_Border 
        Change = #True 
      EndIf 
    Else 
      If Style & #PB_Image_Border 
        Width  - ImageGadgetBorderWidth()  * 2 
        Height - ImageGadgetBorderHeight() * 2 
        Style & ~#PB_Image_Border 
        Change = #True 
      EndIf 
    EndIf 
    
    If Change 
      SetWindowLong_(GadgetID, #GWL_EXSTYLE, Style) 
      SetWindowPos_(GadgetID, 0, 0, 0, Width, Height, #SWP_NOMOVE | #SWP_FRAMECHANGED) 
    EndIf 
    
    Set = #True 
  EndIf 
  
  ProcedureReturn Set 
EndProcedure 

Procedure Release_Mouse()
   Mouse_x = WindowMouseX(#win) 
   Mouse_y = WindowMouseY(#win)
   If Mouse_x = -1  Or Mouse_y = -1
    ProcedureReturn 0
   EndIf 
EndProcedure 

Procedure Disable_MouseOver()
 StatusBarText(#Statusbar, 0, "RollOver effects") 
  SetImageGadgetBorder(#Btn_1, #False) 
  SetImageGadgetBorder(#Btn_2, #False) 
  If GetGadgetFont(#Txt_Btn_1) <> FontParDefaut 
    SetGadgetFont(#Txt_Btn_1,#PB_Default) 
  EndIf 
  If GetGadgetFont(#Txt_Btn_2) <> FontParDefaut 
    SetGadgetFont(#Txt_Btn_2,#PB_Default) 
  EndIf 
  If GetGadgetFont(#texto) <> FontParDefaut 
    SetGadgetFont(#texto,#PB_Default) 
  EndIf 
EndProcedure 


Global FontParDefaut.l 

OpenWindow(#win,0,0,240,280,"RollOver Buttons Example",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(#win)) 
SetWindowColor(#win,RGB(157, 173, 206)) 
  
    btn1=ImageGadget(#Btn_1,85,10,100,60,Image1);on se sert d'une image comme bouton 
    TextGadget(#Txt_Btn_1,5,70,220,30,"Button Number 1"+Chr(13)+"Ce bouton vous mène à rien",#PB_Text_Center) 
    SetGadgetColor(#Txt_Btn_1,#PB_Gadget_FrontColor,RGB(255,255,255)) 
    SetGadgetColor(#Txt_Btn_1,#PB_Gadget_BackColor,RGB(157, 173, 206)) 
        
    btn2=ImageGadget(#Btn_2,85,105,100,60,Image0);ImageGadget ajuste sa taille à celle de l'image 
    TextGadget(#Txt_Btn_2,5,165,220,30,"Button Number 2"+Chr(13)+"Celui-ci non plus d'ailleurs",#PB_Text_Center) 
    SetGadgetColor(#Txt_Btn_2,#PB_Gadget_FrontColor,RGB(255,255,255)) 
    SetGadgetColor(#Txt_Btn_2,#PB_Gadget_BackColor,RGB(157, 173, 206)) 
    
    Texto=TextGadget(#texto,5,210,220,30,"Mais vous pourriez leur donner une destination",#PB_Text_Center) 
    SetGadgetColor(#texto,#PB_Gadget_FrontColor,RGB(255,255,255)) 
    SetGadgetColor(#texto,#PB_Gadget_BackColor,RGB(157, 173, 206)) 

    FontParDefaut = GetGadgetFont(#Txt_Btn_1) 
    
;-STATUSBAR 
If CreateStatusBar(#Statusbar, WindowID(#win)) 
    AddStatusBarField(WindowWidth(#win)/2) 
    AddStatusBarField(WindowWidth(#win)/2) 
    StatusBarText(#Statusbar, 0, "RollOver effects",  #PB_StatusBar_Raised) 
    StatusBarText(#Statusbar, 1, "PureBasic Users"+Chr(169),  #PB_StatusBar_Raised|#PB_StatusBar_Right) 
EndIf 


Repeat 
 Event = WaitWindowEvent() 
  Select Event 
   
  Case #WM_MOUSEMOVE 
    If IsMouseOver(btn1):SetCursor_(MyHand) 
      StatusBarText(#Statusbar, 0, "Bouton 1 survolé") 
      SetImageGadgetBorder(#Btn_1, #True) 
      SetImageGadgetBorder(#Btn_2, #False) 
      If GetGadgetFont(#Txt_Btn_1) <> Font0 
         SetGadgetFont(#Txt_Btn_1,Font0) 
      EndIf 
      If GetGadgetFont(#Txt_Btn_2) <> FontParDefaut 
         SetGadgetFont(#Txt_Btn_2,#PB_Default) 
      EndIf 
      If GetGadgetFont(#texto) <> FontParDefaut 
        SetGadgetFont(#texto,#PB_Default) 
      EndIf 
    ElseIf IsMouseOver(btn2):SetCursor_(MyHand) 
      StatusBarText(#Statusbar, 0, "Bouton 2 survolé") 
      SetImageGadgetBorder(#Btn_1, #False) 
      SetImageGadgetBorder(#Btn_2, #True) 
      If GetGadgetFont(#Txt_Btn_1) <> FontParDefaut 
         SetGadgetFont(#Txt_Btn_1,#PB_Default) 
      EndIf 
      If GetGadgetFont(#Txt_Btn_2) <> Font0 
         SetGadgetFont(#Txt_Btn_2,Font0) 
      EndIf 
      If GetGadgetFont(#texto) <> FontParDefaut 
        SetGadgetFont(#texto,#PB_Default) 
      EndIf 
    ElseIf IsMouseOver(Texto):SetCursor_(Start) 
      StatusBarText(#Statusbar, 0, "Votre texto activé") 
      SetImageGadgetBorder(#Btn_1, #False) 
      SetImageGadgetBorder(#Btn_2, #False) 
      If GetGadgetFont(#Txt_Btn_1) <> FontParDefaut 
         SetGadgetFont(#Txt_Btn_1,#PB_Default) 
      EndIf 
      If GetGadgetFont(#Txt_Btn_2) <> FontParDefaut 
         SetGadgetFont(#Txt_Btn_2,#PB_Default) 
      EndIf 
      If GetGadgetFont(#texto) <> Font0 
         SetGadgetFont(#texto,Font0) 
      EndIf 
    Else 
      StatusBarText(#Statusbar, 0, "RollOver effects") 
      SetImageGadgetBorder(#Btn_1, #False) 
      SetImageGadgetBorder(#Btn_2, #False) 
      If GetGadgetFont(#Txt_Btn_1) <> FontParDefaut 
         SetGadgetFont(#Txt_Btn_1,#PB_Default) 
      EndIf 
      If GetGadgetFont(#Txt_Btn_2) <> FontParDefaut 
         SetGadgetFont(#Txt_Btn_2,#PB_Default) 
      EndIf 
      If GetGadgetFont(#texto) <> FontParDefaut 
        SetGadgetFont(#texto,#PB_Default) 
      EndIf 
    EndIf 
    
  Case #PB_Event_Gadget 
     Select EventGadget() 
      
     Case #Btn_1 
       Select EventType() 
           Case #PB_EventType_LeftClick 
             MessageRequester("BOUTON 1","Pas de programme de destination",#IDI_HAND) 
             If Release_Mouse()=0
                Disable_MouseOver()
            EndIf 
       EndSelect 
      
      
     Case #Btn_2 
       Select EventType() 
         Case #PB_EventType_LeftClick 
           MessageRequester("BOUTON 2","Pas de programme de destination",#IDI_APPLICATION) 
           If Release_Mouse()=0
                Disable_MouseOver()
            EndIf
       EndSelect 
      
     EndSelect 
   EndSelect 
Until Event = #PB_Event_CloseWindow 
End 
voili voilou, ça fonctionne mais c'est un peu lourdingue tout ça... :?
m'enfin bon, @+
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Fonctionne pas chez moi.
Répondre