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

Timestamp:

Jul 13, 2008, 1:47:20 PM (16 years ago)

Author:

イグトランス (egtra)

Message:

キー関連とCreateイベントの追加

File:

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

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

@@ -14 +14 @@
 Class Control
 Public
-
-'1
-
     Sub Control()
     End Sub
@@ -47 +44 @@
 
 '--------------------------------
-' 1 ウィンドウ作成
+' ウィンドウ作成
 /*
     Function Create(
@@ -90 +87 @@
 Public
     Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
-/*
-        Select Case msg
-            Case WM_MOUSELEAVE
-                OnMouseLeave(makeMouseEventFromWPLP(wp, lp))
-                mouseEntered = False
-            Case WM_KEYDOWN
-                OnKeyDown(New KeyEventArgs(makeKeysFormWPLP(wp, lp)))
-            Case WM_KEYUP
-                OnKeyUp(New KeyEventArgs(makeKeysFormWPLP(wp, lp)))
-            Case WM_CHAR
-                OnKeyPress(New KeyPressEventArgs(wp As Char))
-'           Case WM_CREATE
-            Case WM_DESTROY
-                OnDestroy(EventArgs.Empty)
-            Case Else
-                WndProc = DefWndProc(msg, wp, lp)
-        End Select
-*/
         Dim h = Nothing As MessageEventHandler
         Dim b = messageMap.TryGetValue(Hex$(msg), h)
@@ -126 +105 @@
 
 Private
-    Static Function makeKeysFormWPLP(wp As WPARAM, lp As LPARAM) As Keys
+    Static Function makeKeysFormMsg(e As MessageEventArgs) As Keys
         Dim t As DWord
-        t = wp And Keys.KeyCode
+        t = e.WParam And Keys.KeyCode
         t Or= (GetKeyState(VK_SHIFT) As Word And &h8000) << 1
         t Or= (GetKeyState(VK_CONTROL) As Word And &h8000) << 2
         t Or= (GetKeyState(VK_MENU) As Word And &h8000) << 3
-        makeKeysFormWPLP = t As Keys
-    End Function
-
-    Static Function makeMouseEventFromWPLP(wp As WPARAM, lp As LPARAM) As MouseEventArgs
-        makeMouseEventFromWPLP = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
+        makeKeysFormMsg = t As Keys
+    End Function
+
+    Static Function makeMouseEventFromMsg(e As MessageEventArgs) As MouseEventArgs
+        Dim wp = e.WParam
+        Dim lp = e.LParam
+        makeMouseEventFromMsg = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
     End Function
 
@@ -146 +127 @@
     Sub StartWndProc()
         Dim t = This '#177対策
-        messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
         AddMessageEvent(WM_ERASEBKGND, AddressOf(t.OnEraseBackground))
         Dim md = New MessageEventHandler(AddressOf(t.OnMouseDownBase))
@@ -163 +143 @@
         AddMessageEvent(WM_MBUTTONDBLCLK, mu)
         AddMessageEvent(WM_XBUTTONDBLCLK, mu)
+
+        AddMessageEvent(WM_MOUSELEAVE, AddressOf(t.OnMouseLeaveBase))
         AddMessageEvent(WM_PAINT, AddressOf(t.OnPaintBase))
+        AddMessageEvent(WM_KEYDOWN, AddressOf(t.OnKeyDownBase))
+'       AddMessageEvent(WM_CHAR, AddressOf(t.OnChar))   
+        AddMessageEvent(WM_CREATE, AddressOf(t.OnCreateBase))
     End Sub
 
@@ -174 +159 @@
 
     Sub OnMouseDownBase(sender As Object, e As MessageEventArgs)
-        OnMouseDown(makeMouseEventFromWPLP(e.WParam, e.LParam))
+        OnMouseDown(makeMouseEventFromMsg(e))
     End Sub
 
     Sub OnMouseUpBase(sender As Object, e As MessageEventArgs)
-        Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
+        Dim me = makeMouseEventFromMsg(e)
         If doubleClickFired = False Then
-            OnClick(EventArgs.Empty)
+'           OnClick(System.EventArgs.Empty)
             OnMouseClick(me)
             doubleClickFired = False
@@ -188 +173 @@
 
     Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs)
-        Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
+        Dim me = makeMouseEventFromMsg(e)
         doubleClickFired = True
         OnMouseDown(me)
-        OnDoubleClick(EventArgs.Empty)
+'       OnDoubleClick(System.EventArgs.Empty)
         OnMouseDoubleClick(me)
     End Sub
 
     Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs)
-        Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
+        Dim me = makeMouseEventFromMsg(e)
         If mouseEntered Then
             OnMouseMove(me)
@@ -205 +190 @@
     End Sub
 
+    Sub OnMouseLeaveBase(sender As Object, e As MessageEventArgs)
+        Dim me = makeMouseEventFromMsg(e)
+        OnMouseLeave(me)
+        mouseEntered = False
+    End Sub
+
     Sub OnPaintBase(sender As Object, e As MessageEventArgs)
         Dim ps As PAINTSTRUCT
         BeginPaint(hwnd, ps)
-'       Try
-'           OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
-'       Finally
+        Try
+            OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
+        Finally
             EndPaint(hwnd, ps)
-'       End Try
-    End Sub
-
+        End Try
+    End Sub
+
+    Sub OnKeyDownBase(sender As Object, e As MessageEventArgs)
+        OnKeyDown(New KeyEventArgs(makeKeysFormMsg(e)))
+    End Sub
+
+    Sub OnKeyUpBase(sender As Object, e As MessageEventArgs)
+        OnKeyUp(New KeyEventArgs(makeKeysFormMsg(e)))
+    End Sub
+
+'   コメントアウト解除のときはStartWndProcのコメントアウト解除も忘れないこと
+'   Sub OnChar(sender As Object, e As MessageEventArgs)
+'       OnKeyPress(New KeyPressEventArgs(e.WParam As Char))
+'   End Sub
+
+    Sub OnCreateBase(sender As Object, e As MessageEventArgs)
+        OnCreate(New CreateEventArgs(e.LParam As *CREATESTRUCT))
+    End Sub
 
     messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageEventHandler>
@@ -260 +267 @@
 '--------
 'イベント
-' 3
 
 #include "ControlEvent.sbp"
 
 '--------------------------------
-' 1 インスタンスメンバ変数
+' インスタンスメンバ変数
 Private
     hwnd As HWND
@@ -281 +287 @@
 
 '--------------------------------
-' 1 初期ウィンドウクラス
+' 初期ウィンドウクラス
 Private
     Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
@@ -339 +345 @@
 
 '--------------------------------
-' 1 初期化終了関連（特にウィンドウクラス）
+' 初期化終了関連（特にウィンドウクラス）
 Private
     'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの
@@ -450 +456 @@
     Inherits Form
 Public
-    Sub NcDestory(sender As Object, et As EventArgs)
+    Sub t()
+        Dim f = This
+        f.AddMessageEvent(WM_DESTROY, AddressOf (f.Destory))
+        f.AddPaintDC(AddressOf (f.Paint))
+    End Sub
+
+    Sub Destory(sender As Object, e As EventArgs)
+        OutputDebugString(Ex"Destory\r\n")
         PostQuitMessage(0)
     End Sub
+
+    Sub Paint(sender As Object, e As PaintDCEventArgs)
+        TextOut(e.Handle, 10, 10, "Hello world!", 12)
+    End Sub
 End Class
 
 Dim f = New MyForm
+f.t()
 f.Create()
-Dim h = New MessageEventHandler(AddressOf (f.NcDestory))
-f.AddMessageEvent(WM_NCDESTROY, h)
 ShowWindow(f.Handle, SW_SHOW)
 
@@ -481 +497 @@
 
 End
-