Changeset 637

Timestamp:

2008/09/29 01:02:27 (4 years ago)

Author:

egtra

Message:

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

Location:

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

Files:

• Button.ab (modified) (2 diffs)
• Control.ab (modified) (9 diffs)
• Dialog.ab (modified) (2 diffs)
• EditBox.ab (modified) (2 diffs)
• Form.ab (modified) (1 diff)
• WindowHandle.sbp (modified) (4 diffs)

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

@@ -13 +13 @@
 */
 Class Button
-    Inherits Control
+    Inherits WmCommandControl
 Protected
     Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
@@ -26 +26 @@
     End Sub
 
+    Override Function RaiseCommandEvent(notificationCode As Word) As Boolean
+        Dim lr As LRESULT
+        RaiseCommandEvent = False
+        Select Case notificationCode
+            Case BN_CLICKED
+                RaiseCommandEvent = OnClick(Args.Empty)
+            Case BN_DBLCLK
+                RaiseCommandEvent = OnDoubleClick(Args.Empty)
+            Case BN_SETFOCUS
+                RaiseCommandEvent = ProcessMessage(WM_SETFOCUS, 0, 0, lr)
+            Case BN_KILLFOCUS
+                RaiseCommandEvent = ProcessMessage(WM_KILLFOCUS, 0, 0, lr)
+            'ここに挙げられなかったBNメッセージは、16ビットWindowsとの互換性のためとされているもの。
+        End Select
+    End Function
+
 End Class
 

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

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

@@ -8 +8 @@
     Inherits Form
 Public
-
-    Override Function DefWndProc(m As DWord, w As WPARAM, l As LPARAM) As LRESULT
-        DefWndProc = FALSE
-    End Function
-
     Function DoModal(hwndParent As HWND) As Long
         Dim temp[31] As Byte
@@ -20 +15 @@
         StartWndProc()
         DoModal = DialogBoxIndirectParam(Control.hInstance, temp As *DLGTEMPLATE, hwndParent, AddressOf(DefDlgProc), 0)
+    End Function
+Protected
+    Override Function DefWndProc(m As DWord, w As WPARAM, l As LPARAM) As LRESULT
+        DefWndProc = FALSE
     End Function
 

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

@@ -8 +8 @@
 /*!
 @brief エディトコントロールのクラス
-@date 2007/07/21
+@date 2008/07/21
 @auther Egtra
 */
 Class EditBox
-    Inherits Control
+    Inherits WmCommandControl
 Protected
     Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
@@ -19 +19 @@
         End With
     End Sub
+Public
+    Override Function RaiseCommandEvent(notificationCode As Word) As Boolean
+        RaiseCommandEvent = False
+    End Function
 
     'ToDo: Lineなどを設ける

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

@@ -39 +39 @@
 
     Sub OnCommand(sender As Object, e As MessageArgs)
-        Dim id = e.WParam And &hffff 'LOWORD(e.WParam)
-        Dim cmd = (e.WParam >> 16) And &hffff 'HIWORD(e.WParam)
+'       Dim id = e.WParam And &hffff 'LOWORD(e.WParam)
+        Dim cmd = ((e.WParam >> 16) And &hffff) As Word 'HIWORD(e.WParam)
         Dim hwnd = e.LParam As HWND
-        If cmd = BN_CLICKED And hwnd <> 0 Then
-            Dim c = Control.FromHWnd(hwnd)
+        If hwnd <> 0 Then
+            Dim c = Control.FromHWnd(hwnd) As WmCommandControl
             If IsNothing(c) = False Then
-                Dim b = c As Button
-                b.RaiseClick()
+                c.RaiseCommandEvent(cmd)
             End If
         End If

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

@@ -308 +308 @@
     End Function
 */
-    Function Move(x As Long, y As Long, width As Long, height As Long, repaint As Boolean) As Boolean
+    Function Move(x As Long, y As Long, width As Long, height As Long, repaint = True As Boolean) As Boolean
         Return MoveWindow(hwnd, x, y, width, height, repaint) As Boolean
     End Function
 
-    Function Move(x As Long, y As Long, width As Long, height As Long) As Boolean
-        Return MoveWindow(hwnd, x, y, width, height, TRUE) As Boolean
-    End Function
-
-    Function Move(ByRef rc As RECT, repaint As Boolean) As Boolean
+    Function Move(ByRef rc As RECT, repaint = True As Boolean) As Boolean
         With rc
             Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, repaint) As Boolean
@@ -322 +318 @@
     End Function
 
-    Function Move(ByRef rc As RECT) As Boolean
-        With rc
-            Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, TRUE) As Boolean
-        End With
-    End Function
 /*
     Function OpenClipboard() As Boolean
@@ -586 +577 @@
 
     Const Function Maximized() As Boolean
-        Return IsIconic() As Boolean
+        Return IsZoomed(hwnd) As Boolean
     End Function
 
@@ -668 +659 @@
         sb.Length = size
         Dim length = GetWindowText(hwnd, StrPtr(sb), size)
+        sb.Length(length)
         Text = sb.ToString
     End Function