Evènement mouse in, mouse out

nico · Message par **nico** » lun. 09/oct./2006 18:04

Voici un code simple pour ajouter deux évènements MouseIn et MouseOut dans vos codes.

#Container=0
#Button1 = 1 
#Text1 = 2
#Panel = 3
#Button2 = 4
#Text2 = 5

#MouseIn=256
#MouseOut=512

Global MouseQuit

Procedure MouseOver(Window)
Static message,MemGadget.w=65535,MemParent.l=0,MemHandle.l
     Repeat
        GetCursorPos_(@point.POINT)
        handle=WindowFromPoint_(point\X,point\Y)
        Thread1 = GetWindowThreadProcessId_(Window, @Pid1)
        Parent= GetParent_(handle)
        Thread2 = GetWindowThreadProcessId_(Parent, @Pid2) 
        GadgetID= GetDlgCtrlID_(handle)
        If Thread1=Thread2
            If MemGadget <> GadgetID
                message=1
                PostMessage_(MemParent,#WM_COMMAND,#MouseOut<<16+MemGadget,MemHandle)
                PostMessage_(Parent,#WM_COMMAND,#MouseIn<<16+GadgetID,handle)
                MemGadget= GadgetID
                MemParent= Parent
                MemHandle= handle
            EndIf 
        Else
           If message=1
                PostMessage_(MemParent,#WM_COMMAND,#MouseOut<<16+MemGadget,MemHandle)
                MemGadget=65535
                message=0
           EndIf 
        EndIf      
        Delay(50)
     Until MouseQuit=1
EndProcedure


If OpenWindow(0, 0, 0, 320, 360, "ContainerGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
    OpenWindow(1, 0, 0, 320, 360, "", #PB_Window_SystemMenu )
    
    CreateThread(@MouseOver(),WindowID(0))
   
    CreateGadgetList(WindowID(0)) 
    ContainerGadget(#Container, 8, 8, 306, 133, #PB_Container_Raised) 
    ButtonGadget(#Button1, 10, 20, 120, 20, "Bouton 1",#PB_Text_Border) 
    TextGadget(#Text1, 130, 20, 120, 20, "Bouton 2",#PB_Text_Border) 
    SetGadgetText(#Button1,"Bouton 1")
    SetGadgetText(#Text1,"Texte2")
    CloseGadgetList() 
    
    PanelGadget     (#Panel, 10, 160, 300, 100)
    AddGadgetItem (#Panel, -1, "Onglet 1")
    ButtonGadget(4, 10, 15, 120, 20,"Bouton 1")
    TextGadget(5, 130, 15, 120, 20,"Bouton 2",#PB_Text_Border)
    CloseGadgetList()

  
    Repeat 
    Event.l=WaitWindowEvent()
    Select Event 
      Case #PB_Event_Gadget
        Select EventGadget()
        
        
              Case #Button1
                  Select EventType()
                      Case #PB_EventType_LeftClick
                          Debug "Click1"
                          
                      Case #MouseIn
                          SetGadgetText(#Button1,"Mouse over Bouton 1")
                          
                      Case #MouseOut
                          SetGadgetText(#Button1,"Mouse quit Bouton 1")
                  EndSelect  
                  
                  
              Case #Text1
                  Select EventType()          
                      Case #MouseIn
                          SetGadgetText(#Text1,"Mouse over Texte 1")
                          
                      Case #MouseOut
                          SetGadgetText(#Text1,"Mouse quit Texte 1")
                  EndSelect 
                  
                  
              Case #Button2
                  Select EventType()
                      Case #PB_EventType_LeftClick
                          Debug "Click2"
                          
                      Case #MouseIn
                          SetGadgetText(#Button2,"Mouse over Bouton 2")
                          
                      Case #MouseOut
                          SetGadgetText(#Button2,"Mouse quit Bouton 2")
                  EndSelect 
                   
                   
              Case #Text2
                  Select EventType()                  
                      Case #MouseIn
                          SetGadgetText(#Text2,"Mouse over Texte 2")
                          
                      Case #MouseOut
                          SetGadgetText(#Text2,"Mouse quit Texte 2")
                  EndSelect 
          
          EndSelect
      EndSelect       
      Until Event = #PB_Event_CloseWindow
      MouseQuit=1
 EndIf

Vous pouvez remplacer le thread par un timer au besoin.

Backup · Message par **Backup** » lun. 09/oct./2006 22:08

...........

nico · Message par **nico** » mar. 10/oct./2006 17:36

Normalement, le code doit fonctionner sur tout type de gadget. Il respecte la philosophie Pb en rajoutant deux évènements; ces évènements ne se déclenchent qu'une seule fois donc pas de scintillement et fonctionne correctement en passant d'une fenêtre à l'autre, du moins j'espère.

nico · Message par **nico** » lun. 31/mars/2008 16:14

Voici une nouvelle version améliorée qui permet de recevoir un évènement lorsque la souris se positionne une première fois au dessus d'un gadget et lorsque la souris quitte le gadget.

Une seule fonction: AddMouseOverWindow(Procédure,#Fenêtre[,Option])
la Procédure peut être différente pour chaque fenêtre
Si c'est le cas, inutile de tester la valeur Window de la procédure
Si Option=1, on annule le MouseOver pour la #Fenêtre spécifiée,
dans ce cas le paramètre Procédure est ignorée

Le fichier à inclure:

Code : Tout sélectionner

#MouseIn=1
#MouseOut=2

Global WM_MOUSEOVER
WM_MOUSEOVER=RegisterWindowMessage_("#WM_MOUSEOVER")

Declare.l CreateMouseOver(window.l)

Procedure.l SubclassingOverWindow( hWnd, Msg,  wParam, lParam)
  Protected OriginProc.l,AdresseProc.l,WindowID.l
  ;Ici on récupère l'adresse d'origine de la procédure grâce à la
  ;chaine qui l'identifie: "OriginProc" et le handle de la fenêtre
  ;voir la fonction SetProp_(...).
  OriginProc.l= GetProp_(hWnd, "MouseOverWindow")
  AdresseProc.l= GetProp_(hWnd, "MouseOver")
  
  WindowID=GetWindowLong_(hWnd, #GWL_ID)
  
  Select Msg
    Case WM_MOUSEOVER
            CallFunctionFast(AdresseProc,WindowID,wParam,lParam)
        ProcedureReturn 0
        
    Case #WM_NCDESTROY
        ;Remettre la procédure d'origine
        SetWindowLong_(hWnd, #GWL_WNDPROC, OriginProc)
        ;Supprimer les données associées à la fenêtre.
        RemoveProp_(hWnd,"MouseOverWindow")
        RemoveProp_(hWnd,"MouseOver")     
  EndSelect
  ;On renvoie tous les autres évènements à la procédure d'origine.
  ProcedureReturn CallWindowProc_(OriginProc,hWnd,Msg,wParam,lParam)
EndProcedure

Procedure.l AddMouseOverWindow(Adresse.l,WindowID.l,Delete.l=0)
    Protected Window.l,OriginProc.l
    Static ListHandle.s,Init.l

    If Init=0
        Init=1
        CreateThread(@CreateMouseOver(),0)
    EndIf 
    
    If Delete=2
        ProcedureReturn @ListHandle
    EndIf 

    If IsWindow(WindowID)
        Window=WindowID(WindowID)
        If FindString(ListHandle,Str(Window)+" ",1)
            If Delete
                ListHandle=RemoveString(ListHandle,Str(Window)+" ")
            EndIf 
        Else
          If Adresse
              OriginProc = SetWindowLong_(Window, #GWL_WNDPROC, @SubclassingOverWindow())
              SetProp_(Window, "MouseOverWindow", OriginProc)
              SetProp_(Window, "MouseOver",Adresse)
              ListHandle=ListHandle+Str(Window)+" " 
          EndIf 
        EndIf
        ProcedureReturn 1
    EndIf 
EndProcedure

Procedure.l CreateMouseOver(lParam.l)
    Protected Handle.l,Parent.l,Roothandle.l,ListHandle.s,GadgetID.l,Adresse.l
    Static Message,MemGadgetID.l=-1,MemRoot.l
    
    Repeat
        Adresse=AddMouseOverWindow(0,0,2)
        If Adresse
            ListHandle=PeekS(Adresse) 
            
            GetCursorPos_(@Point.POINT)
            
            Handle=WindowFromPoint_(Point\x,Point\y)
            ;GetAncestor Compatible minimum Windows 98, Windows NT 4.0 SP4
            Roothandle=GetAncestor_(Handle,#GA_ROOT)
    
            Parent= GetParent_(Handle)
            ScreenToClient_(Parent,@Point.POINT)
            
            ;RealChildWindowFromPoint Compatible minimum Windows 98, Windows NT 4.0 SP4
            Handle=RealChildWindowFromPoint_(Parent,Point\x,Point\y)
                
            GadgetID= GetDlgCtrlID_(handle) 
            
            If FindString(ListHandle,Str(Roothandle),1)
                If MemGadgetID <> GadgetID
                    Message=1
                    SendMessage_(MemRoot,WM_MOUSEOVER,MemGadgetID,#MouseOut)
                    SendMessage_(MemRoot,WM_MOUSEOVER,GadgetID,#MouseIn)
                    MemGadgetID= GadgetID
                    MemRoot= Roothandle
                EndIf
            Else
                If Message=1
                    SendMessage_(MemRoot,WM_MOUSEOVER,MemGadgetID,#MouseOut)
                    MemGadgetID=-1
                    Message=0
                EndIf
            EndIf
        EndIf     
        Delay(50)
    ForEver 
EndProcedure

Un code pour tester:

Code : Tout sélectionner

Enumeration
  #Fenetre1
  #Fenetre2
EndEnumeration

Enumeration
  #Container
  #Frame1
  #Frame2
  #Button1 
  #Text1 
  #Panel 
  #Button2 
  #Text2
  #Scroll 
  #Frame3
  #Button3
  #Text3
  #Button4
  #Button5
EndEnumeration


Procedure MouseOver(WindowID.l,EventGadget.l,EventType.l)
    Select WindowID
        Case #Fenetre1
            Select EventGadget
                Case #Button1
                    Select EventType              
                        Case #MouseIn
                            SetGadgetText(#Button1,"Mouse over Bouton 1")
                            
                        Case #MouseOut
                            SetGadgetText(#Button1,"Mouse quit Bouton 1")
                    EndSelect 
                            
                Case #Text1
                    Select EventType         
                        Case #MouseIn
                            SetGadgetText(#Text1,"Mouse over Texte 1")
                            
                        Case #MouseOut
                            SetGadgetText(#Text1,"Mouse quit Texte 1")
                    EndSelect  
                    
                Case #Button2
                    Select EventType                 
                        Case #MouseIn
                            SetGadgetText(#Button2,"Mouse over Bouton 2")
                            
                        Case #MouseOut
                            SetGadgetText(#Button2,"Mouse quit Bouton 2")
                    EndSelect
                    
                    
                Case #Text2
                    Select EventType                 
                        Case #MouseIn
                            SetGadgetText(#Text2,"Mouse over Texte 2")
                            
                        Case #MouseOut
                            SetGadgetText(#Text2,"Mouse quit Texte 2")
                    EndSelect
                    
                Case #Text3
                    Select EventType                 
                        Case #MouseIn
                            SetGadgetText(#Text3,"Mouse over Texte 3")
                            
                        Case #MouseOut
                            SetGadgetText(#Text3,"Mouse quit Texte 3")
                    EndSelect
                     
                Case #Button3
                    Select EventType                 
                        Case #MouseIn
                            SetGadgetText(#Button3,"Mouse over Boutton 3")
                            
                        Case #MouseOut
                            SetGadgetText(#Button3,"Mouse quit Boutton 3")
                    EndSelect
                    
                Case #Button4
                    Select EventType                 
                        Case #MouseIn
                            SetGadgetText(#Button4,"Mouse over Boutton 4")
                            
                        Case #MouseOut
                            SetGadgetText(#Button4,"Mouse quit Boutton 4")
                    EndSelect
                    
                Case #Button5
                    Select EventType                 
                        Case #MouseIn
                            SetGadgetText(#Button5,"Mouse over Boutton 5")
                            
                        Case #MouseOut
                            SetGadgetText(#Button5,"Mouse quit Boutton 5")
                    EndSelect
        EndSelect 
                    
        Case #Fenetre2
            Select EventGadget      
                Case #Button5
                    Select EventType                 
                        Case #MouseIn
                            SetGadgetText(#Button5,"Mouse over Boutton 5")
                            
                        Case #MouseOut
                            SetGadgetText(#Button5,"Mouse quit Boutton 5")
                    EndSelect 
            EndSelect
    EndSelect 
EndProcedure

If OpenWindow(0, 0, 0, 600, 600, "Fenêtre 1", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

    OpenWindow(1, 0, 0, 320, 360, "Fenêtre 2", #PB_Window_SystemMenu )
    
    ; AddMouseOverWindow(Procédure,#Fenêtre[,Option])
    ; La procédure peut être différente pour chaque fenêtre
    ; Si c'est le cas, inutile de tester la valeur Window de la procédure
    ; Si Option=1, on annule le MouseOver pour la #Fenêtre spécifiée,
    ; dans ce cas le paramètre Procédure est ignorée
    
    AddMouseOverWindow(@MouseOver(),0)
    AddMouseOverWindow(@MouseOver(),1)
    
    CreateGadgetList(WindowID(1))
    ButtonGadget(#Button5, 100, 100, 120, 20, "Bouton 5",#PB_Text_Border)
    
    CreateGadgetList(WindowID(0))
    ContainerGadget(#Container, 10, 10, 400, 200, #PB_Container_Raised)
        Frame3DGadget(#Frame1, 10,  10, 380, 180, "Frame 1")
        Frame3DGadget(#Frame2, 20,  80, 360, 80, "Frame 2")
        ButtonGadget(#Button1, 100, 100, 120, 20, "Bouton 1",#PB_Text_Border)
        TextGadget(#Text1, 130, 40, 120, 20, "Texte 1",#PB_Text_Border)
    CloseGadgetList()
    
    PanelGadget(#Panel, 10, 240, 300, 100)
        AddGadgetItem (#Panel, -1, "Onglet 1")
        ButtonGadget(#Button2, 10, 15, 120, 20,"Bouton 2")
        TextGadget(#Text2, 130, 15, 120, 20,"Texte 2",#PB_Text_Border)
    CloseGadgetList()
    
    ScrollAreaGadget(#Scroll, 10, 400, 380, 120, 340, 240, 10) 
    Frame3DGadget(#Frame3, 10,  0, 300, 80, "Frame 3")  
    ButtonGadget(#Button3, 20, 25, 120, 25, "Boutton 3")
    TextGadget(#Text3, 20, 100, 100, 15, "Texte 3")
    CloseGadgetList()
    
    ButtonGadget(#Button4, 420, 25, 120, 25, "Boutton 4")
    
    Repeat
        Event.l=WaitWindowEvent()
        Select Event
            Case #PB_Event_Gadget
                Select EventGadget()
                    Case #Button1
                        Select EventType()
                            Case #PB_EventType_LeftClick
                                ; Supprime le mouseover de la fenêtre 2
                                AddMouseOverWindow(0,1,1)
                                MessageRequester("Info","Supression du MouseOver de la Fenêtre 2")
                        EndSelect 
                       
                EndSelect
        EndSelect       
    Until Event = #PB_Event_CloseWindow
    MouseQuit=1
EndIf

nico · Message par **nico** » lun. 31/mars/2008 21:28

Code mis à jour.

nico · Message par **nico** » mar. 01/avr./2008 15:58

Encore une nouvelle version, c'est la plus simple et la moins gourmande en temps processeur, c'est cette version qu'on trouve un peu partout .

Fonctionne à partir de 98,NT 4 SP 4 à cause de l'API RealChildWindowFromPoint comme les autres codes précédents mais on pourrait utiliser d'autres API pour arriver à simuler cette fonction.

La procédure à inclure:

Code : Tout sélectionner

#MouseIn=1
#MouseOut=2

Procedure.l SubclassingOverWindow( hWnd, Msg,  wParam, lParam)
  Protected OriginProc.l,AdresseProc.l,WindowID.L,GadgetID.l
  Protected Window.l,Handle.l,Point.POINT,Result.l
  Static Enter.l
 
  OriginProc.l= GetProp_(hWnd, "OriginProc")
  AdresseProc.l= GetProp_(hWnd, "ProcMouseOver")
 
  Window=GetAncestor_(hWnd,#GA_ROOT)
  WindowID=GetWindowLong_(Window, #GWL_ID)
  GadgetID=GetDlgCtrlID_(hWnd)
  
  Select Msg
    Case #WM_TIMER
        If Wparam=999
            GetCursorPos_(@Point)
            lParam=(Point\y<<16)+ (Point\x)
            Handle=WindowFromPoint_(Point\x,Point\y)
            ScreenToClient_(Handle,@Point)
            Handle=RealChildWindowFromPoint_(Handle,Point\x,Point\y) 
            If Handle<>hWnd
                KillTimer_(hWnd,999)
                CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseOut)
                Enter=0
                PostMessage_(Handle,#WM_NCHITTEST,0,lParam)
                Debug "Quit"
            EndIf
            ProcedureReturn 0
        EndIf
       
    Case #WM_NCHITTEST
        If GetWindowTheme_(hwnd)=0
          Result= DefWindowProc_(hWnd,Msg,wParam,lParam)
          If Result=#HTCLIENT
              If Enter=0
                Enter=1
                   Debug "Enter"
                  CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseIn)
                  SetTimer_(hWnd, 999,20, 0)
              EndIf
          EndIf
       EndIf 
    
    Case #WM_MOUSEFIRST
        If GetWindowTheme_(hwnd)<>0
            If Enter=0
                Enter=1
                CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseIn)
            EndIf 
        EndIf
       
    Case #WM_MOUSELEAVE
        Enter=0
        CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseOut)
    
    Case #WM_NCDESTROY
        SetWindowLong_(hWnd, #GWL_WNDPROC, OriginProc)
        RemoveProp_(hWnd,"OriginProc")
        RemoveProp_(hWnd,"ProcMouseOver")     
  EndSelect
  ProcedureReturn CallWindowProc_(OriginProc,hWnd,Msg,wParam,lParam)
EndProcedure

Procedure.l AddMouseOverGadget(Adresse.l,GadgetID.l)
    Protected Gadget.l,OriginProc.l
   
    If IsGadget(GadgetID)
          Gadget=GadgetID(GadgetID)
          If Adresse
              OriginProc = SetWindowLong_(Gadget, #GWL_WNDPROC, @SubclassingOverWindow())
              SetProp_(Gadget, "OriginProc", OriginProc)
              SetProp_(Gadget, "ProcMouseOver",Adresse)
          EndIf
        ProcedureReturn 1
    EndIf
EndProcedure

Un petit exemple avec les deux cas de figure:

Code : Tout sélectionner

Enumeration
  #Fenetre1
EndEnumeration

Enumeration
  #Button1
  #Button2
EndEnumeration

; Premier cas de figure si vous utilisez la même procédure pour tous les Gadgets
Procedure MouseOver(WindowID.l,EventGadget.l,EventType.l)
    Select WindowID
        Case #Fenetre1
            Select EventGadget
                Case #Button1
                    Select EventType             
                        Case #MouseIn
                            SetGadgetText(#Button1,"Mouse over Bouton 1")
                           
                        Case #MouseOut
                            SetGadgetText(#Button1,"Mouse quit Bouton 1")
                    EndSelect
                    
                Case #Button2
                    Select EventType             
                        Case #MouseIn
                            SetGadgetText(#Button2,"Mouse over Bouton 2")
                           
                        Case #MouseOut
                            SetGadgetText(#Button2,"Mouse quit Bouton 2")
                    EndSelect
            EndSelect            
    EndSelect
EndProcedure

; Deuxième cas de figure, une procédure unique pour chaque Gadget
;-----------------------------------ou-----------------------------------------
Procedure Button1(WindowID.l,EventGadget.l,EventType.l)
    Select EventType             
        Case #MouseIn
            SetGadgetText(#Button1,"Mouse over Bouton 1")
           
        Case #MouseOut
            SetGadgetText(#Button1,"Mouse quit Bouton 1")
    EndSelect            
EndProcedure

Procedure Button2(WindowID.l,EventGadget.l,EventType.l)
    Select EventType             
        Case #MouseIn
            SetGadgetText(#Button2,"Mouse over Bouton 2")
           
        Case #MouseOut
            SetGadgetText(#Button2,"Mouse quit Bouton 2")
    EndSelect         
EndProcedure
;------------------------------------------------------------------------------


If OpenWindow(#Fenetre1, 0, 0, 300, 160, "Fenêtre 1", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CreateGadgetList(WindowID(0))

    ButtonGadget(#Button1, 80, 40, 120, 20, "Bouton 1")
    ButtonGadget(#Button2, 80, 80, 120, 20, "Bouton 2")
    
    ; Une seule fonction:
    ; AddMouseOverGadget(Procedure,GadgetID)
    ; La procedure peut être différente pour chaque Gadget, dans ce cas, il est inutile
    ; de tester la valeur Window
    
    ;--------------même procédure-------------------
    AddMouseOverGadget(@MouseOver(),#Button1)
    AddMouseOverGadget(@MouseOver(),#Button2)

    ;-------------procédure différente--------------
;     AddMouseOverGadget(@Button1(),#Button1)
;     AddMouseOverGadget(@Button2(),#Button2)
    ;-----------------------------------------------
    
    Repeat
        Event.l=WaitWindowEvent()
        Select Event
            Case #PB_Event_Gadget
                Select EventGadget()
                    Case #Button1
                        Select EventType()
                            Case #PB_EventType_LeftClick
                                MessageRequester("Info","Coucou!")
                        EndSelect
                       
                EndSelect
        EndSelect       
    Until Event = #PB_Event_CloseWindow
    MouseQuit=1
EndIf

lionel_om · Message par **lionel_om** » mar. 01/avr./2008 18:53

Merci pour ces codes nico.

Pour le code précédent je ne comprend pas cette ligne :

Code : Tout sélectionner

WM_MOUSEOVER=RegisterWindowMessage_("#WM_MOUSEOVER")

Tu récupère dans WM_MOUSEOVER une valeur. Mais cette variable n'est pas globale, donc lors du Case WM_MOUSEOVER, ca revient à un Case 0.
J'ai essayé le code en commentant la ligne avec l'appel de RegisterWindowMessage_() et le résultat est identique... J'ai aussi essayé en rendant WM_MOUSEOVER global, ça marche toujours.

Bizarre qd mm !!!

Lio

nico · Message par **nico** » mar. 01/avr./2008 19:22

Bien vu pour l'erreur, WM_MOUSEOVER vaut bien 0 ce qui correspond au message #WM_NULL, il faut mettre WM_MOUSEOVER en global pour avoir un message unique grâce à RegisterWindowMessage.

J'ai corrigé.

nico · Message par **nico** » jeu. 03/avr./2008 16:09

Code mis à jour!

Losrque les thêmes sont activés sur les boutons, le timer n'est plus utile, on traite les messages #WM_MOUSEFIRST et #WM_MOUSELEAVE.

Dans le message: #WM_NCHITTEST j'ai du tester cette valeur de retour:Result= DefWindowProc_(hWnd,Msg,wParam,lParam) , car il pouvait y avoir un problème avec les ImageGadget avec bordure.

Donc le MouseIn et le mouseOut fonctionne lorsque le curseur se trouve dans une zone cliente et pas sur la bordure, ce qui est un fonctionnement normal puisque si vous cliquer sur un gadget et que vous recevez un évènement c'est que vous avez cliqué sur la zone cliente.

dans le message #WM_TIMER, j'ai rajouté cette ligne:PostMessage_(Handle,#WM_NCHITTEST,0,lParam), car lorsqu'on a deux gadget qui se touche (façon de parler), que le curseur est sur le dernier pixel du gadget (gadgets sans bordure) et qu'on se déplace d'un pixel, le gadget qui avait le over reçoit bien le message quit mais le gadget qui reçoit la souris ne peut traiter le message WM_NCHITTEST car Enter vaut 1 à ce moment là.

Pour s'en rendre compte , il suffit de passer le timer à 2 seconde.

nico · Message par **nico** » ven. 04/avr./2008 14:55

Je me suis aperçu d'un petit problème en voulant faire un exemple de tooltip personnalisé avec les évènements MouseIn et MouseOut.

Code corrigé, voici la modification:

Code : Tout sélectionner

    Case #WM_MOUSEFIRST
        If GetWindowTheme_(hwnd)<>0
            If Enter=0
                Enter=1
                CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseIn)
            EndIf 
        EndIf
       
    Case #WM_MOUSELEAVE
        Enter=0
        CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseOut)

Un petit exemple avec des Tooltips personnalisés:

Code : Tout sélectionner

#MouseIn=1
#MouseOut=2

Procedure.l SubclassingOverWindow( hWnd, Msg,  wParam, lParam)
  Protected OriginProc.l,AdresseProc.l,WindowID.L,GadgetID.l
  Protected Window.l,Handle.l,Point.POINT,Result.l
  Static Enter.l
 
  OriginProc.l= GetProp_(hWnd, "OriginProc")
  AdresseProc.l= GetProp_(hWnd, "ProcMouseOver")
 
  Window=GetAncestor_(hWnd,#GA_ROOT)
  WindowID=GetWindowLong_(Window, #GWL_ID)
  GadgetID=GetDlgCtrlID_(hWnd)
 
  Select Msg
    Case #WM_TIMER
        If Wparam=999
            GetCursorPos_(@Point)
            lParam=(Point\y<<16)+ (Point\x)
            Handle=WindowFromPoint_(Point\x,Point\y)
            ScreenToClient_(Handle,@Point)
            Handle=RealChildWindowFromPoint_(Handle,Point\x,Point\y)
            If Handle<>hWnd
                KillTimer_(hWnd,999)
                CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseOut)
                Enter=0
                PostMessage_(Handle,#WM_NCHITTEST,0,lParam)
            EndIf
            ProcedureReturn 0
        EndIf
       
    Case #WM_NCHITTEST
        If GetWindowTheme_(hwnd)=0
          Result= DefWindowProc_(hWnd,Msg,wParam,lParam)
          If Result=#HTCLIENT
              If Enter=0
                Enter=1
                  CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseIn)
                  SetTimer_(hWnd, 999,20, 0)
              EndIf
          EndIf
       EndIf
   
    Case #WM_MOUSEFIRST
        If GetWindowTheme_(hwnd)<>0
            If Enter=0
                Enter=1
                CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseIn)
            EndIf
        EndIf
       
    Case #WM_MOUSELEAVE
        Enter=0
        CallFunctionFast(AdresseProc,WindowID,GadgetID,#MouseOut)
   
    Case #WM_NCDESTROY
        SetWindowLong_(hWnd, #GWL_WNDPROC, OriginProc)
        RemoveProp_(hWnd,"OriginProc")
        RemoveProp_(hWnd,"ProcMouseOver")     
  EndSelect
  ProcedureReturn CallWindowProc_(OriginProc,hWnd,Msg,wParam,lParam)
EndProcedure

Procedure.l AddMouseOverGadget(Adresse.l,GadgetID.l)
    Protected Gadget.l,OriginProc.l
   
    If IsGadget(GadgetID)
          Gadget=GadgetID(GadgetID)
          If Adresse
              OriginProc = SetWindowLong_(Gadget, #GWL_WNDPROC, @SubclassingOverWindow())
              SetProp_(Gadget, "OriginProc", OriginProc)
              SetProp_(Gadget, "ProcMouseOver",Adresse)
          EndIf
        ProcedureReturn 1
    EndIf
EndProcedure
 
 
Procedure CreateToolTip()
   Protected ToolInfo.ToolInfo
 
   Global Tooltip.l
 
   #TTF_TRANSPARENT = $100

   Tooltip = CreateWindowEx_ (0, "tooltips_class32" , 0 ,#WS_POPUP |#TTS_ALWAYSTIP,0, 0, 0, 0, 0, 0, 0, 0)
   SendMessage_ (Tooltip, #TTM_SETTIPTEXTCOLOR , RGB (0, 85, 223), 0)
   SendMessage_ (Tooltip, #TTM_SETTIPBKCOLOR , RGB (255, 255, 223), 0)
   SendMessage_ (Tooltip, #TTM_SETMAXTIPWIDTH , 0, 300)

   SendMessage_ (Tooltip, #TTM_SETTITLE , #TTI_INFO , "" )

   SendMessage_ (Tooltip, #TTM_SETDELAYTIME , #TTDT_AUTOPOP ,3000) ;Durée de l'apparition du Tooltip
   SendMessage_ (Tooltip, #TTM_SETDELAYTIME , #TTDT_INITIAL ,100) ;Délai avant l'apparition du Tooltip
EndProcedure

Procedure ModifyToolTip(ID_Window.l,ID_Gadget.l,Title.s,Text.s)
    Static ToolInfo.ToolInfo
   
    SendMessage_ (Tooltip, #TTM_ACTIVATE ,0,0)
    SendMessage_ (Tooltip, #TTM_DELTOOL,0, @ToolInfo)
   
    ToolInfo\cbSize = SizeOf (ToolInfo)
    ToolInfo\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS | #TTF_TRANSPARENT
    ToolInfo\hwnd = WindowID(ID_Window)
    ToolInfo\uId = GadgetID(ID_Gadget)
    ToolInfo\lpszText = @Text
    GetClientRect_(GadgetID(ID_Gadget), @ToolInfo\rect)

    SendMessage_ (Tooltip, #TTM_ADDTOOL , 0, @ToolInfo)
    SendMessage_ (Tooltip, #TTM_SETTITLE , #TTI_INFO , Title)
    SendMessage_ (Tooltip, #TTM_ACTIVATE ,1,0)
EndProcedure

Enumeration
  #Fenetre1
EndEnumeration

Enumeration
  #Button1
  #Button2
EndEnumeration

Procedure MouseOver(WindowID.l,EventGadget.l,EventType.l)
    Select WindowID
        Case #Fenetre1
            Select EventGadget
                Case #Button1
                    Select EventType             
                        Case #MouseIn
                            ModifyToolTip(#Fenetre1,#Button1,"Info","Mouse over Bouton 1")
                           
                        Case #MouseOut

                    EndSelect
                   
                Case #Button2
                    Select EventType             
                        Case #MouseIn
                            ModifyToolTip(#Fenetre1,#Button2,"Info","Mouse over Bouton 2")
                           
                        Case #MouseOut

                    EndSelect
            EndSelect           
    EndSelect
EndProcedure


If OpenWindow(#Fenetre1, 0, 0, 300, 160, "Fenêtre 1", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CreateGadgetList(WindowID(0))

    ButtonGadget(#Button1, 80, 40, 120, 20, "Bouton 1")
    ButtonGadget(#Button2, 80, 80, 120, 20, "Bouton 2")
   
    AddMouseOverGadget(@MouseOver(),#Button1)
    AddMouseOverGadget(@MouseOver(),#Button2)

    CreateToolTip()
    Repeat
        Event.l=WaitWindowEvent()
        Select Event
            Case #PB_Event_Gadget
                Select EventGadget()
                    Case #Button1
                        Select EventType()
                            Case #PB_EventType_LeftClick
                                MessageRequester("Info","Coucou!")
                        EndSelect
                       
                EndSelect
        EndSelect       
    Until Event = #PB_Event_CloseWindow
    MouseQuit=1
EndIf

nico · Message par **nico** » mer. 09/avr./2008 9:43

Code corrigé, une erreur dans la création du Tooltip et petite simplification.

lionel_om · Message par **lionel_om** » mer. 09/avr./2008 20:43

Merci pour ces codes et leurs fixs !

Lio

Ar-S · Message par **Ar-S** » mer. 09/avr./2008 22:44

C'est très joli ! bravo

nico · Message par **nico** » jeu. 10/avr./2008 7:57

Merci,

J'ai remarqué un truc aussi, c'est que #TTS_BALLOON ne fonctionne pas si le control est Hot Tracking, c'est à dire tous les controls qui change d'apparence lorsque le curseur est au dessus d'eux comme les boutons sur XP , avec les thèmes, ainsi que la Toolbar etc..; c'est pour ça que je n'utilise pas cette constante ici.

nico · Message par **nico** » jeu. 10/avr./2008 8:25

J'ai trouvé sur le Forum Anglais la réponse, pour que TTS_BALLOON fonctionne avec les thèmes, il faut aller vérifier une clé dans la base de registre:EnableBalloonTips (faire edition rechercher) et mettre la valeur 1.

Je ne sais pas le faire par le code, jamais utilisé la base de registre.