Event MouseIn and MouseOut

Nico · Post by **Nico** » Tue Oct 10, 2006 5:55 pm

Here a code to add two event to make a rollover easily :

#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
                Delay(20)
            EndIf 
        Else
           If message=1
                PostMessage_(MemParent,#WM_COMMAND,#MouseOut<<16+MemGadget,MemHandle)
                MemGadget=65535
                message=0
           EndIf 
        EndIf      
        Delay(20)
     Until MouseQuit=1
EndProcedure


If OpenWindow(0, 0, 0, 320, 360, "ContainerGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
    
    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

Nico · Post by **Nico** » Tue Apr 01, 2008 4:13 pm

Simple way to to include MouseIn and MouseOut, work 98 , NT4 SP4 and more.

The procedure to include:

Code: Select all

#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
          ProcedureReturn Result
       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

A little example With two scenarios:

Code: Select all

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
                         MessageRequester("Info","Coucou!")
                       
                EndSelect
        EndSelect       
    Until Event = #PB_Event_CloseWindow
    MouseQuit=1
EndIf

Code: Select all

Nico · Post by **Nico** » Fri Apr 04, 2008 2:49 pm

Just an exmple to use:

Code: Select all

#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
          ProcedureReturn Result
       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)
   
    *MemToolInfo=@ToolInfo

    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
                         MessageRequester("Info","Coucou!")
                       
                EndSelect
        EndSelect       
    Until Event = #PB_Event_CloseWindow
    MouseQuit=1
EndIf

Code: Select all