Changeset 575 for trunk/ab5.0/ablib/src/Classes
- Timestamp:
- Aug 3, 2008, 3:58:05 AM (16 years ago)
- Location:
- trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows
- Files:
-
- 4 edited
-
UI/Application.ab (modified) (5 diffs)
-
UI/Control.ab (modified) (19 diffs)
-
UI/EventArgs.ab (modified) (3 diffs)
-
Windows.ab (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Application.ab
r559 r575 1 1 'Classes/ActiveBasic/Windows/UI/Application.ab 2 3 #require <Classes/ActiveBasic/Windows/UI/Form.ab> 2 4 3 5 Namespace ActiveBasic 4 6 Namespace Windows 5 7 Namespace UI 8 9 Delegate Function MessageFilter(m As *MSG) As Boolean 6 10 7 11 /*! … … 23 27 form.Show(SW_SHOW) 24 28 form.Update() 25 form.AddMessageEvent(WM_DESTROY, AddressOf( Application.OnMainFormClosed))29 form.AddMessageEvent(WM_DESTROY, AddressOf(OnMainFormClosed)) 26 30 End If 27 31 … … 32 36 Exit Do 33 37 End If 34 TranslateMessage(m) 35 DispatchMessage(m) 38 dispatchMessage(m) 36 39 Loop 37 40 … … 70 73 PostQuitMessage(0) 'Run()で捕まえてくれるようPostしなおす。 71 74 Case Else 72 TranslateMessage(msg) 73 DispatchMessage(msg) 75 dispatchMessage(msg) 74 76 End Select 75 77 Wend 76 78 End Sub 79 /* 80 Static Sub AddMessageFilter(mf As MessageFilter) 81 If IsNothing(filter) Then 82 filter = New System.Collections.Generic.List<MessageFilter> 83 End If 84 filter.Add(mf) 85 End Sub 77 86 87 Static Sub RemoveMessageFilter(mf As MessageFilter) 88 filter.Remove(mf) 89 End Sub 90 */ 78 91 #include "ApplicationEvent.sbp" 79 92 … … 83 96 ExitThread() 84 97 End Sub 98 99 Static Sub dispatchMessage(ByRef m As MSG) 100 /* If IsNothing(filter) = False Then 101 For Each f In filter 102 Next 103 End If 104 */ TranslateMessage(m) 105 DispatchMessage(m) 106 End Sub 107 108 ' Static filter As System.Collections.Generic.List<MessageFilter> 85 109 End Class 86 110 -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab
r564 r575 2 2 3 3 #require <Classes/ActiveBasic/Windows/UI/EventArgs.ab> 4 #require <Classes/ActiveBasic/COM/ComClassBase.ab> 4 5 5 6 Namespace ActiveBasic … … 13 14 Class Control 14 15 Inherits WindowHandle 16 Implements ActiveBasic.COM.InterfaceQuerable 15 17 Public 16 18 /*! … … 21 23 22 24 Sub Control() 25 comImpl = New COM.ComClassDelegationImpl(This) 23 26 End Sub 24 27 … … 30 33 End Function 31 34 35 /*! 36 @brief HWNDからControlインスタンスを取得する。 37 @param[in] hwnd 対象のウィンドウハンドル 38 @return 対応するControlインスタンス。ただし、存在しなければNothing。 39 */ 32 40 Static Function FromHWnd(hwnd As HWND) As Control 33 41 FromHWnd = Nothing … … 39 47 Private 40 48 Static Function FromHWndCore(hwnd As HWND) As Control 41 Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR 42 If gchValue <> 0 Then 43 Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue) 44 FromHWndCore = gch.Target As Control 45 Exit Function 46 End If 49 FromHWndCore = _System_PtrObj(GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As VoidPtr) As Control 47 50 End Function 48 51 … … 58 61 59 62 Public 60 Sub Create(parent = Nothing As Control, style = 0 As DWord, exStyle = 0 As DWord, hmenu = 0 As HMENU) 63 /*! 64 @brief ウィンドウを作成する（詳細版）。 65 @date 2008/08/02 66 通常はCreateやCreateFormその他を使ってください。 67 */ 68 Sub CreateEx(parent As Control, style As DWord, exStyle As DWord, hmenu As HMENU) 61 69 Dim cs As CREATESTRUCT 62 70 With cs … … 64 72 .lpszClass = (atom As ULONG_PTR) As LPCTSTR 65 73 .lpszName = 0 66 .style = style Or WS_CHILD Or WS_VISIBLE74 .style = style 67 75 .x = 0 68 76 .y = 0 … … 73 81 Else 74 82 .hwndParent = parent As HWND 75 .style Or= WS_CHILD76 83 End If 77 84 .hMenu = hmenu … … 82 89 End Sub 83 90 84 Sub Create(parent As Control, style As DWord, exStyle As DWord, id As Long) 85 Create(parent, style, exStyle, id As HMENU) 91 /*! 92 @brief ウィンドウを作成する（子ウィンドウ以外）。 93 @date 2008/08/02 94 */ 95 Sub CreateForm(style As DWord, exStyle As DWord, owner = Nothing As Control, hmenu = 0 As HMENU) 96 CreateEx(owner, style, exStyle, hmenu) 97 End Sub 98 99 Sub CreateForm() 100 CreateEx(Nothing, 0, 0, 0) 101 End Sub 102 103 /*! 104 @brief 子ウィンドウを作成する。 105 @date 2008/08/02 106 */ 107 Sub Create(parent As Control, style = 0 As DWord, exStyle = 0 As DWord, id = 0 As Long) 108 CreateEx(parent, style Or WS_CHILD Or WS_VISIBLE, exStyle, id As ULONG_PTR As HMENU) 86 109 End Sub 87 110 Protected … … 89 112 90 113 Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control) 91 Imports System.Runtime.InteropServices92 93 114 If hwnd <> 0 Then 94 115 Throw New System.InvalidOperationException("Window already created.") 95 116 End If 96 97 Dim gch = GCHandle.Alloc(This)98 TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr)99 117 100 118 StartWndProc() … … 105 123 .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams) 106 124 If hwnd = 0 Then 107 Debug108 125 ActiveBasic.Windows.ThrowByWindowsError(GetLastError()) 109 126 End If 110 127 111 128 If IsNothing(FromHWndCore(hwnd)) <> False Then 112 AssociateHWnd( gch,hwnd)129 AssociateHWnd(hwnd) 113 130 TlsSetValue(tlsIndex, 0) 114 131 End If … … 158 175 End Function 159 176 160 /*! 161 @brief 最初にウィンドウプロシージャが呼ばれるときに実行される関数162 ここでは、主なメッセージハンドラの登録を行っている。177 Protected 178 /*! 179 @brief 最初にウィンドウプロシージャを使うための前処理を行う関数 163 180 @date 2008/07/11 181 WndProcFirstを使うときは、この関数を呼んでおく必要がある。 164 182 */ 165 183 Sub StartWndProc() 184 TlsSetValue(tlsIndex, ObjPtr(This)) 185 registerStandardEvent() 186 End Sub 187 Private 188 /*! 189 @brief 主なメッセージハンドラの登録を行う関数 190 @date 2008/08/02 191 */ 192 Sub registerStandardEvent() 166 193 AddMessageEvent(WM_ERASEBKGND, AddressOf(OnEraseBackground)) 167 194 Dim md = New MessageHandler(AddressOf(OnMouseDownBase)) … … 210 237 OnClick(Args.Empty) 211 238 OnMouseClick(me) 239 Else 212 240 doubleClickFired = False 213 241 End If … … 225 253 Sub OnMouseMoveBase(sender As Object, e As MessageArgs) 226 254 Dim me = makeMouseEventFromMsg(e) 227 If mouseEntered Then 228 OnMouseMove(me) 229 Else 255 If mouseEntered = False Then 230 256 mouseEntered = True 231 257 OnMouseEnter(me) 232 258 trackMouseEvent(TME_LEAVE Or TME_HOVER) 233 259 End If 260 OnMouseMove(me) 234 261 End Sub 235 262 … … 338 365 '-------------------------------- 339 366 ' 初期ウィンドウクラス 340 Pr ivate367 Protected 341 368 Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT 342 369 Imports System.Runtime.InteropServices … … 344 371 Dim rThis = FromHWndCore(hwnd) 345 372 If IsNothing(rThis) Then 346 Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR373 rThis = _System_PtrObj(TlsGetValue(tlsIndex)) As Control 347 374 TlsSetValue(tlsIndex, 0) 348 If gchValue = 0Then375 If IsNothing(rThis) Then 349 376 Goto *InstanceIsNotFound 350 377 End If 351 Dim gch = GCHandle.FromIntPtr(gchValue)352 rThis = gch.Target As Control353 378 ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき 354 355 AssociateHWnd(gch, hwnd) 379 rThis.AssociateHWnd(hwnd) 356 380 End If 357 381 If msg = WM_NCDESTROY Then … … 375 399 /*! 376 400 @brief Controlインスタンスとウィンドウハンドルを結び付ける。 377 @param[in] 結び付けられるControlインスタンスを格納したGCHandle378 401 @param[in] hwnd 結び付けるウィンドウハンドル 379 402 @date 2008/07/16 380 これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなる。 381 */ 382 Static Sub AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND) 383 Imports System.Runtime.InteropServices 384 Dim rThis = gch.Target As Control 385 If IsNothing(rThis) Then 386 Exit Sub 387 End If 388 rThis.hwnd = hwnd 389 rThis.Prop[PropertyInstance] = GCHandle.ToIntPtr(gch) As HANDLE 403 これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなると共に、 404 FromHWndでウィンドウハンドルからControlインスタンスの取得が可能となる。 405 */ 406 Sub AssociateHWnd(hwnd As HWND) 407 This.hwnd = hwnd 408 This.Prop[PropertyInstance] = ObjPtr(This) As HANDLE 409 comImpl.AddRef() 390 410 End Sub 391 411 … … 412 432 413 433 Sub UnassociateHWnd() 414 Imports System.Runtime.InteropServices 415 Dim gchValue = Prop(PropertyInstance) As ULONG_PTR 416 If gchValue <> 0 Then 417 GCHandle.FromIntPtr(gchValue).Free() 418 End If 434 comImpl.Release() 419 435 End Sub 420 436 … … 422 438 ' Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord 423 439 440 '-------------------------------- 441 ' インタフェース実装 442 443 Public 444 Virtual Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT 445 QueryInterfaceImpl = E_NOTIMPL 446 End Function 447 448 Private 449 comImpl As COM.ComClassDelegationImpl 424 450 '-------------------------------- 425 451 ' その他の補助関数 -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab
r564 r575 17 17 Sub MessageArgs(hwndSrc As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) 18 18 msg = message 19 'hwnd = hwndSrc19 hwnd = hwndSrc 20 20 wp = wParam 21 21 lp = lParam … … 27 27 End Function 28 28 29 'Const Function HWnd() As HWND30 'HWnd = hwnd31 'End Function29 Const Function HWnd() As HWND 30 HWnd = hwnd 31 End Function 32 32 33 33 Const Function WParam() As WPARAM … … 48 48 Private 49 49 msg As DWord 50 'hwnd As HWND50 hwnd As HWND 51 51 wp As WPARAM 52 52 lp As LPARAM -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Windows.ab
r561 r575 101 101 Dim pszMsg As PCSTR 102 102 FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 103 0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg) , 0, 0)103 0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg) As PTSTR, 0, 0) 104 104 If pszMsg <> 0 Then 105 105 hresultToString = New String(pszMsg)
Note:
See TracChangeset
for help on using the changeset viewer.
