Changeset 564 for trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab

Timestamp:

Jul 22, 2008, 1:12:35 AM (16 years ago)

Author:

イグトランス (egtra)

Message:

MouseLeave, MouseHoverが動作するようにした。

File:

• trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab (modified) (8 diffs)

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab

@@ -7 +7 @@
 Namespace UI
 
-'Namespace Detail
-'   TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL
-'End Namespace
+Namespace Detail
+    TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL
+End Namespace
 
 Class Control
@@ -176 +176 @@
         AddMessageEvent(WM_XBUTTONUP, mu)
         Dim mb = New MessageHandler(AddressOf(OnMouseDblClkBase))
-        AddMessageEvent(WM_LBUTTONDBLCLK, mu)
-        AddMessageEvent(WM_RBUTTONDBLCLK, mu)
-        AddMessageEvent(WM_MBUTTONDBLCLK, mu)
-        AddMessageEvent(WM_XBUTTONDBLCLK, mu)
+        AddMessageEvent(WM_LBUTTONDBLCLK, mb)
+        AddMessageEvent(WM_RBUTTONDBLCLK, mb)
+        AddMessageEvent(WM_MBUTTONDBLCLK, mb)
+        AddMessageEvent(WM_XBUTTONDBLCLK, mb)
 
         AddMessageEvent(WM_MOUSEMOVE, AddressOf(OnMouseMoveBase))
         AddMessageEvent(WM_MOUSELEAVE, AddressOf(OnMouseLeaveBase))
+        AddMessageEvent(WM_MOUSEHOVER, AddressOf(OnMouseHoverBase))
         AddMessageEvent(WM_PAINT, AddressOf(OnPaintBase))
         AddMessageEvent(WM_KEYDOWN, AddressOf(OnKeyDownBase))
@@ -191 +192 @@
 
     Sub OnEraseBackground(sender As Object, e As MessageArgs)
-        Dim rc = ClientRect
-        FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
+        If IsNothing(paintBackground) Then
+            Dim rc = ClientRect
+            FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
+        Else
+            OnPaintBackground(New PaintBackgroundArgs(e.WParam, e.LParam))
+        End If
         e.LResult = TRUE
     End Sub
@@ -225 +230 @@
             mouseEntered = True
             OnMouseEnter(me)
+            trackMouseEvent(TME_LEAVE Or TME_HOVER)
         End If
     End Sub
 
     Sub OnMouseLeaveBase(sender As Object, e As MessageArgs)
+        OnMouseLeave(Args.Empty)
+        mouseEntered = False
+    End Sub
+
+    Sub OnMouseHoverBase(sender As Object, e As MessageArgs)
         Dim me = makeMouseEventFromMsg(e)
-        OnMouseLeave(me)
-        mouseEntered = False
+        OnMouseHover(me)
     End Sub
 
@@ -415 +425 @@
 '   その他の補助関数
 Private
-'   Sub tracMouseEvent()
-/*      If pTrackMouseEvent <> 0 Then
+    Function trackMouseEvent(flags As DWord) As BOOL
+        If pTrackMouseEvent <> 0 Then
             Dim tme As TRACKMOUSEEVENT
             With tme
                 .cbSize = Len(tme)
-                .dwFlags = TME_HOVER Or TME_LEAVE
-                .hwndTrack = wnd
+                .dwFlags = flags
+                .hwndTrack = hwnd
                 .dwHoverTime = HOVER_DEFAULT
             End With
-            pTrackMouseEvent(tme)
-        End If
-*/  'End Sub
+            trackMouseEvent = pTrackMouseEvent(tme)
+        End If
+    End Function
 
 '--------------------------------
@@ -437 +447 @@
     Static atom As ATOM
     Static hmodComctl As HMODULE
-'   Static pTrackMouseEvent As PTrackMouseEvent
+    Static pTrackMouseEvent As Detail.PTrackMouseEvent
 
     Static Const WindowClassName = "ActiveBasic.Windows.UI.Control"
@@ -445 +455 @@
         tlsIndex = TlsAlloc()
         hInstance = hinst
-'       hmodComctl = LoadLibrary("comctl32.dll")
-'       pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent"))
+        hmodComctl = LoadLibrary("comctl32.dll")
+        pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent")) As Detail.PTrackMouseEvent
 
         Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId())
@@ -483 +493 @@
             TlsFree(tlsIndex)
         End If
-'       If hmodComctl <> 0 Then
-'           FreeLibrary(hmodComctl)
-'       End If
+        If hmodComctl <> 0 Then
+            FreeLibrary(hmodComctl)
+        End If
         If PropertyInstance <> 0 Then
             GlobalDeleteAtom(PropertyInstance)