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

Timestamp:

Aug 24, 2008, 5:28:59 PM (16 years ago)

Author:

イグトランス (egtra)

Message:

サブクラス化機構(Control.Attach)の整備

File:

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

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

@@ -12 +12 @@
 End Namespace
 
+/*
+@brief Windowsのウィンドウを管理する基底クラス
+@auther Egtra
+*/
 Class Control
     Inherits WindowHandle
@@ -24 +28 @@
     Sub Control()
         comImpl = New COM.ComClassDelegationImpl(This)
-    End Sub
-
-    Virtual Sub ~Control()
     End Sub
 
@@ -52 +53 @@
 '--------------------------------
 ' ウィンドウ作成
-'   Function Create(
-'       parent As HWND,
-'       rect As RECT,
-'       name As String,
-'       style As DWord,
-'       exStyle = 0 As DWord,
-'       menu = 0 As HMENU) As HWND
 
 Public
@@ -108 +102 @@
         CreateEx(parent, style Or WS_CHILD Or WS_VISIBLE, exStyle, id As ULONG_PTR As HMENU)
     End Sub
+
 Protected
     Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
 
     Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control)
-        If hwnd <> 0 Then
-            Throw New System.InvalidOperationException("Window already created.")
-        End If
+        throwIfAlreadyCreated()
 
         StartWndProc()
@@ -123 +116 @@
                 .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
             If hwnd = 0 Then
-                ActiveBasic.Windows.ThrowWithLastError()
+                ThrowWithLastErrorNT("Control.CreateEx")
             End If
             
@@ -134 +127 @@
         If IsNothing(parent) = False Then
             RegisterUnassociateHWnd(parent)
+        End If
+    End Sub
+
+Public
+    Sub Attach(hwndNew As HWND)
+        throwIfAlreadyCreated()
+        If hwndNew = 0 Then
+            Throw New System.ArgumentNullException("Control.Attach")
+        End If
+        registerStandardEvent()
+        AssociateHWnd(hwndNew)
+        prevWndProc = SetWindowLongPtr(GWLP_WNDPROC, AddressOf(WndProcFirst) As LONG_PTR) As WNDPROC
+    End Sub
+
+Private
+    Sub throwIfAlreadyCreated()
+        If hwnd <> 0 Then
+            Throw New System.InvalidOperationException("Window already created.")
         End If
     End Sub
@@ -148 +159 @@
                 Dim a = New MessageArgs(hwnd, msg, wp, lp)
                 h(This, a)
-                WndProc = a.LResult
-                Exit Function
+                If a.Handled Then
+                    WndProc = a.LResult
+                    Exit Function
+                End If
             End If
         End If
@@ -156 +169 @@
 
     Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
-        DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
+        If prevWndProc Then
+            DefWndProc = CallWindowProc(prevWndProc, hwnd, msg, wp, lp)
+        Else
+            DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
+        End If
     End Function
 
@@ -219 +236 @@
 
     Sub OnEraseBackground(sender As Object, e As MessageArgs)
-        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
+        Dim a = New PaintBackgroundArgs(e.WParam, e.LParam)
+        e.Handled = e.Handled And OnPaintBackground(a)
+        e.LResult = a.Painted
     End Sub
 
     Sub OnMouseDownBase(sender As Object, e As MessageArgs)
-        OnMouseDown(makeMouseEventFromMsg(e))
+        e.Handled = e.Handled And OnMouseDown(makeMouseEventFromMsg(e))
     End Sub
 
@@ -240 +253 @@
             doubleClickFired = False
         End If
-        OnMouseUp(me)
+        e.Handled = e.Handled And OnMouseUp(me)
     End Sub
 
@@ -248 +261 @@
         OnMouseDown(me)
         OnDoubleClick(Args.Empty)
-        OnMouseDoubleClick(me)
+        e.Handled = e.Handled And OnMouseDoubleClick(me)
     End Sub
 
@@ -258 +271 @@
             trackMouseEvent(TME_LEAVE Or TME_HOVER)
         End If
-        OnMouseMove(me)
+        e.Handled = e.Handled And OnMouseMove(me)
     End Sub
 
     Sub OnMouseLeaveBase(sender As Object, e As MessageArgs)
-        OnMouseLeave(Args.Empty)
+        e.Handled = e.Handled And OnMouseLeave(Args.Empty)
         mouseEntered = False
     End Sub
@@ -268 +281 @@
     Sub OnMouseHoverBase(sender As Object, e As MessageArgs)
         Dim me = makeMouseEventFromMsg(e)
-        OnMouseHover(me)
+        e.Handled = e.Handled And OnMouseHover(me)
     End Sub
 
     Sub OnPaintBase(sender As Object, e As MessageArgs)
-        Dim ps As PAINTSTRUCT
-        BeginPaint(ps)
-        Try
-            OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
-        Finally
-            EndPaint(ps)
-        End Try
+        If ActiveBasic.IsNothing(paintDC) Then
+            e.Handled = False
+        Else
+            Dim ps As PAINTSTRUCT
+            BeginPaint(ps)
+            Try
+                OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
+            Finally
+                EndPaint(ps)
+            End Try
+        End If
     End Sub
 
     Sub OnKeyDownBase(sender As Object, e As MessageArgs)
-        OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
+        e.Handled = e.Handled And OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
     End Sub
 
     Sub OnKeyUpBase(sender As Object, e As MessageArgs)
-        OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
+        e.Handled = e.Handled And OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
     End Sub
 
     Sub OnChar(sender As Object, e As MessageArgs)
-        OnKeyPress(New KeyPressArgs(e.WParam As Char))
+        e.Handled = e.Handled And OnKeyPress(New KeyPressArgs(e.WParam As Char))
     End Sub
 
     Sub OnCreateBase(sender As Object, e As MessageArgs)
-        OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
+        e.Handled = e.Handled And OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
     End Sub
 
     Sub OnSize(sender As Object, e As MessageArgs)
-        OnResize(New ResizeArgs(e.WParam, e.LParam))
+        e.Handled = e.Handled And OnResize(New ResizeArgs(e.WParam, e.LParam))
     End Sub
 
@@ -352 +369 @@
 Private
     /*!
+    @brief  サブクラス化前のウィンドウプロシージャ
+    @date   2008/08/23
+    サブクラス化していなければNULL
+    */
+    prevWndProc As WNDPROC
+    /*!
     @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ
     外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。
@@ -381 +404 @@
         If msg = WM_NCDESTROY Then
             rThis.UnassociateHWnd()
+            rThis.hwnd = 0
         End If
         If msg = WM_DESTROY And IsNothing(rThis.finalDestroy) = False Then
             Dim f = rThis.finalDestroy
             f(rThis, Args.Empty)
-'           finalDestroy(This, Args.Empty)
         End If
         WndProcFirst = rThis.WndProc(msg, wp, lp)
@@ -391 +414 @@
 
     *InstanceIsNotFound
-        Dim err = "ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found. msg = &h" _
-            + Hex$(msg) + Ex"\r\n"
+        Dim err = String.Concat("Control.WndProcFirst: The attached instance is not found. msg = &h",
+            Hex$(msg), Ex"\r\n")
         OutputDebugString(ToTCStr(err))
         WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
@@ -399 +422 @@
     /*!
     @brief  Controlインスタンスとウィンドウハンドルを結び付ける。
-    @param[in] hwnd 結び付けるウィンドウハンドル
+    @param[in] hwndNew  結び付けるウィンドウハンドル
     @date   2008/07/16
     これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなると共に、
     FromHWndでウィンドウハンドルからControlインスタンスの取得が可能となる。
     */
-    Sub AssociateHWnd(hwnd As HWND)
-        This.hwnd = hwnd
-        This.Prop[PropertyInstance] = ObjPtr(This) As HANDLE
+    Sub AssociateHWnd(hwndNew As HWND)
+        hwnd = hwndNew
+        Prop[PropertyInstance] = ObjPtr(This) As HANDLE
         comImpl.AddRef()
     End Sub
@@ -429 +452 @@
     Sub UnassociateHWndOnEvent(sender As Object, e As Args)
         UnassociateHWnd()
+        hwnd = 0
     End Sub
 
@@ -447 +471 @@
 
 Private
+    /*!
+    @brief ウィンドウの寿命管理
+    Controlには次のAddRef-Releaseの対がある。
+    @li createImpl - WM_NCDESTROY（ウィンドウプロシージャがWndProcFirstの場合）
+    @li createImpl - UnassociateHWnd←UnassociateHWndOnEvent←RegisterUnassociateHWnd（その他のウィンドウクラスの場合）
+    @li Attach - WM_NCDESTROY（サブクラス化された場合）
+    なお、Control派生クラスをサブクラス化すると、後ろ2つが両方適用される。
+    */
     comImpl As COM.ComClassDelegationImpl
+
 '--------------------------------
 '   その他の補助関数
@@ -526 +559 @@
         End If
     End Sub
-
 End Class