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

Timestamp:

Sep 29, 2008, 1:02:27 AM (16 years ago)

Author:

イグトランス (egtra)

Message:

Button.OnClickの仕組みを汎用的（WM_COMMAND全般）に。WndProcなどをProtectedへ。

File:

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

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

@@ -138 +138 @@
         registerStandardEvent()
         AssociateHWnd(hwndNew)
+    End Sub
+
+    Sub BeginSubclass()
+        throwIfNotCreated()
         prevWndProc = SetWindowLongPtr(GWLP_WNDPROC, AddressOf(WndProcFirst) As LONG_PTR) As WNDPROC
     End Sub
@@ -144 +148 @@
     Sub throwIfAlreadyCreated()
         If hwnd <> 0 Then
-            Throw New System.InvalidOperationException("Window already created.")
+            Throw New System.InvalidOperationException("Window is already created.")
+        End If
+    End Sub
+
+    Sub throwIfNotCreated()
+        If hwnd = 0 Then
+            Throw New System.InvalidOperationException("Window is not already created.")
         End If
     End Sub
@@ -150 +160 @@
 '--------------------------------
 ' ウィンドウプロシージャ
-'Protected
-Public
+
+Protected
     Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
+        If Not ProcessMessage(msg, wp, lp, WndProc) Then
+            WndProc = DefWndProc(msg, wp, lp)
+        End If
+    End Function
+
+    Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
+        If prevWndProc Then
+            DefWndProc = CallWindowProc(prevWndProc, hwnd, msg, wp, lp)
+        Else
+            DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
+        End If
+    End Function
+Protected
+    Function ProcessMessage(msg As DWord, wp As WPARAM, lp As LPARAM, ByRef lr As LRESULT) As Boolean
         Dim h = Nothing As MessageHandler
         Dim b = messageMap.TryGetValue(Hex$(msg), h)
@@ -160 +184 @@
                 h(This, a)
                 If a.Handled Then
-                    WndProc = a.LResult
+                    lr = a.LResult
+                    ProcessMessage = True
                     Exit Function
                 End If
             End If
         End If
-        WndProc = DefWndProc(msg, wp, lp)
-    End Function
-
-    Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
-        If prevWndProc Then
-            DefWndProc = CallWindowProc(prevWndProc, hwnd, msg, wp, lp)
-        Else
-            DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
-        End If
-    End Function
-
+        ProcessMessage = False
+    End Function
 Private
     Static Function makeKeysFormMsg(e As MessageArgs) As Keys
@@ -428 +444 @@
     */
     Sub AssociateHWnd(hwndNew As HWND)
-        hwnd = hwndNew
+        SetHWnd(hwndNew)
         Prop[PropertyInstance] = ObjPtr(This) As HANDLE
         comImpl.AddRef()
@@ -513 +529 @@
     Static Sub Initialize(hinst As HINSTANCE)
         tlsIndex = TlsAlloc()
+        If tlsIndex = TLS_OUT_OF_INDEXES Then
+            ThrowWithLastError("Control.Initialize: TlsAlloc failed.")
+        End If
         hInstance = hinst
         hmodComctl = LoadLibrary("comctl32.dll")
@@ -519 +538 @@
         Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId())
         PropertyInstance = GlobalAddAtom(ToTCStr(PropertyInstanceString))
+        If PropertyInstance = 0 Then
+            ThrowWithLastError("Control.Initialize: GlobalAddAtom failed.")
+        End If
 
         Dim wcx As WNDCLASSEX
@@ -537 +559 @@
         atom = RegisterClassEx(wcx)
         If atom = 0 Then
-            Dim buf[1023] As TCHAR
-            wsprintf(buf, Ex"ActiveBasic.Windows.UI.Control.Control: RegisterClasseEx failed. Error code: &h%08X\r\n", GetLastError())
-            OutputDebugString(buf)
-            Debug
-            ExitThread(0)
+            ThrowWithLastErrorNT("Control.Initialize: RegisterClasseEx failed.")
         End If
     End Sub
@@ -561 +579 @@
 End Class
 
+/*!
+@brief WM_COMMANDで通知を行うコントロールの基底クラス
+@date 2008/08/28
+@auther Egtra
+親がWM_COMMANDを受け取ったら、RaiseCommandEventを呼ぶことを意図している。
+（Formで実装済み）
+*/
+Class WmCommandControl
+    Inherits Control
+Public
+    Abstract Function RaiseCommandEvent(notificationCode As Word) As Boolean
+End Class
+
 End Namespace 'UI
 End Namespace 'Widnows