Changeset 564

Timestamp:

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

Author:

イグトランス (egtra)

Message:

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

Location:

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

Files:

• Control.ab (modified) (8 diffs)
• ControlEvent.sbp (modified) (5 diffs)
• ControlEventList.txt (modified) (2 diffs)
• EventArgs.ab (modified) (1 diff)

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)

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEvent.sbp

@@ -176 +176 @@
 
 Public
-    Sub AddMouseLeave(h As MouseHandler)
+    Sub AddMouseLeave(h As Handler)
         If IsNothing(mouseLeave) Then
             mouseLeave = h
@@ -183 +183 @@
         End If
     End Sub
-    Sub RemoveMouseLeave(h As MouseHandler)
+    Sub RemoveMouseLeave(h As Handler)
         If Not IsNothing(mouseLeave) Then
             mouseLeave -= h
@@ -189 +189 @@
     End Sub
 Protected
-    Sub OnMouseLeave(e As MouseArgs)
+    Sub OnMouseLeave(e As Args)
         If Not IsNothing(mouseLeave) Then
             mouseLeave(This, e)
@@ -195 +195 @@
     End Sub
 Private
-    mouseLeave As MouseHandler
+    mouseLeave As Handler
 
 Public
@@ -395 +395 @@
     destroy As Handler
 
+Public
+    Sub AddPaintBackground(h As PaintBackgroundHandler)
+        If IsNothing(paintBackground) Then
+            paintBackground = h
+        Else
+            paintBackground += h
+        End If
+    End Sub
+    Sub RemovePaintBackground(h As PaintBackgroundHandler)
+        If Not IsNothing(paintBackground) Then
+            paintBackground -= h
+        End If
+    End Sub
+Protected
+    Sub OnPaintBackground(e As PaintBackgroundArgs)
+        If Not IsNothing(paintBackground) Then
+            paintBackground(This, e)
+        End If
+    End Sub
+Private
+    paintBackground As PaintBackgroundHandler
+

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEventList.txt

@@ -11 +11 @@
 MouseMove   Mouse   マウスカーソルがコントロール上で移動すると呼び出されます
 MouseHover  Mouse   マウスカーソルがコントロール上で静止すると呼び出されます。
-MouseLeave  Mouse   マウスカーソルがコントロールから出て行くと呼び出されます。
+MouseLeave      マウスカーソルがコントロールから出て行くと呼び出されます。
 MouseDown   Mouse   マウスボタンが押されたときに呼び出されます。
 MouseClick  Mouse   マウスでクリックされたときに呼び出されます。
@@ -22 +22 @@
 Create  Create  ウィンドウが作成されたときに呼ばれます。
 Destroy     ウィンドウが破棄されるときに呼ばれます。
+PaintBackground PaintBackground 背景の描画を行うときに呼ばれます。

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

@@ -545 +545 @@
 Delegate Sub ResizeHandler(sender As Object, e As ResizeArgs)
 
+Class PaintBackgroundArgs
+    Inherits Args
+Public
+    Sub PaintBackgroundArgs(hdc As HDC)
+        This.hdc = hdc
+    End Sub
+
+    Sub PaintBackgroundArgs(wp As WPARAM, lp As LPARAM)
+        This.hdc = wp As HDC
+    End Sub
+
+    Const Function Handle() As HDC
+        Handle = hdc
+    End Function
+Private
+    hdc As HDC
+End Class
+
+Delegate Sub PaintBackgroundHandler(sender As Object, e As PaintBackgroundArgs)
+
 End Namespace 'UI
 End Namespace 'Widnows