source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab@ 711

Last change on this file since 711 was 711, checked in by イグトランス (egtra), 14 years ago

WM_PAINTCLIENTもOnPaintDCで処理されるよう変更

File size: 18.7 KB
Line 
1'Classes/ActiveBasic/Windows/UI/Control.ab
2
3#require <Classes/ActiveBasic/Windows/UI/WindowHandle.ab>
4#require <Classes/ActiveBasic/Windows/UI/EventArgs.ab>
5#require <Classes/ActiveBasic/COM/ComClassBase.ab>
6
7Namespace ActiveBasic
8Namespace Windows
9Namespace UI
10
11Namespace Detail
12 TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL
13End Namespace
14
15/*
16@brief Windowsのウィンドウを管理する基底クラス
17@auther Egtra
18*/
19Class Control
20 Inherits WindowHandle
21 Implements ActiveBasic.COM.InterfaceQuerable
22Public
23 /*!
24 @brief Destroyイベントよりも後に呼ばれるDestroyイベントデリゲート
25 @date 2008/07/16
26 */
27 finalDestroy As ActiveBasic.Windows.UI.Handler
28
29 Sub Control()
30 comImpl = New COM.ComClassDelegationImpl(This)
31 End Sub
32
33 Function Handle() As HWND
34 Handle = hwnd
35 End Function
36
37 /*!
38 @brief HWNDからControlインスタンスを取得する。
39 @param[in] hwnd 対象のウィンドウハンドル
40 @return 対応するControlインスタンス。存在しなければ作成される。ただし、hwndがNULLならNothing。
41 */
42 Static Function FromHWnd(hwnd As HWND) As Control
43 FromHWnd = Nothing
44 If IsWindow(hwnd) Then
45 FromHWnd = FromHWndCore(hwnd)
46 If ActiveBasic.IsNothing(FromHWnd) Then
47 Dim lock = New ActiveBasic.Windows.CriticalSectionLock(_System_CriticalSection)
48 Try
49 FromHWnd = New Control
50 FromHWnd.registerStandardEvent()
51 FromHWnd.AssociateHWnd(hwnd)
52 Finally
53 lock.Dispose()
54 End Try
55 End If
56 End If
57 End Function
58
59 Function AddRef() As DWord
60 AddRef = comImpl.AddRef()
61 End Function
62
63 Function Release() As DWord
64 Release = comImpl.Release()
65 End Function
66
67 Function QueryInterface(ByRef riid As IID, ByRef pv As Any) As HRESULT
68 QueryInterface = comImpl.QueryInterface(riid, pv)
69 End Function
70
71Private
72 Static Function FromHWndCore(hwnd As HWND) As Control
73 FromHWndCore = _System_PtrObj(GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As VoidPtr) As Control
74 End Function
75
76'--------------------------------
77' ウィンドウ作成
78
79Public
80 /*!
81 @brief ウィンドウを作成する(詳細版)。
82 @date 2008/08/02
83 通常はCreateやCreateFormその他を使ってください。
84 ここで渡された引数は、GetCreateStructへ渡して修正の機会を与えた後に、
85 CreateWindowExへ渡される。
86 */
87 Sub CreateEx(parent As Control, style As DWord, exStyle As DWord, hmenu As HMENU)
88 Dim cs As CREATESTRUCT
89 With cs
90 .dwExStyle = exStyle
91 .lpszClass = (atom As ULONG_PTR) As LPCTSTR
92 .lpszName = 0
93 .style = style
94 .x = 0
95 .y = 0
96 .cx = 0
97 .cy = 0
98 If IsNothing(parent) Then
99 .hwndParent = 0
100 Else
101 .hwndParent = parent As HWND
102 End If
103 .hMenu = hmenu
104 .hInstance = hInstance
105 End With
106 GetCreateStruct(cs)
107 createImpl(cs, parent)
108 End Sub
109
110 /*!
111 @brief ウィンドウを作成する(子ウィンドウ以外)。
112 @date 2008/08/02
113 */
114 Sub CreateForm(style As DWord, exStyle As DWord, owner = Nothing As Control, hmenu = 0 As HMENU)
115 CreateEx(owner, style, exStyle, hmenu)
116 End Sub
117
118 Sub CreateForm()
119 CreateEx(Nothing, 0, 0, 0)
120 End Sub
121
122 /*!
123 @brief 子ウィンドウを作成する。
124 @date 2008/08/02
125 */
126 Sub Create(parent As Control, style = 0 As DWord, exStyle = 0 As DWord, id = 0 As Long)
127 CreateEx(parent, style Or WS_CHILD Or WS_VISIBLE, exStyle, id As ULONG_PTR As HMENU)
128 End Sub
129
130Protected
131 /*!
132 @brief ウィンドウ作成前の初期設定確認
133 派生クラスでオーバーライドして、csを書き換えてよい。
134 書き換えられたcsを基にCreateWindowExが呼ばれる。
135 */
136 Virtual Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
137 End Sub
138
139Private
140 Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control)
141 throwIfAlreadyCreated()
142
143 StartWndProc()
144
145 With cs
146 'よそのウィンドウクラスの場合、WndProcFirst内のhwndの代入が行われないため、ここでも行っておく。
147 hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
148 .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
149 If hwnd = 0 Then
150 ThrowWithLastErrorNT("Control.CreateEx")
151 End If
152
153 If IsNothing(FromHWndCore(hwnd)) <> False Then
154 AssociateHWnd(hwnd)
155 TlsSetValue(tlsIndex, 0)
156 End If
157 End With
158
159 If IsNothing(parent) = False Then
160 RegisterUnassociateHWnd(parent)
161 End If
162 End Sub
163
164Public
165/*
166 Sub Attach(hwndNew As HWND)
167 throwIfAlreadyCreated()
168 If hwndNew = 0 Then
169 Throw New System.ArgumentNullException("Control.Attach")
170 End If
171 registerStandardEvent()
172 AssociateHWnd(hwndNew)
173 End Sub
174*/
175
176 Sub BeginSubclass()
177 throwIfNotCreated()
178 prevWndProc = SetWindowLongPtr(hwnd, GWLP_WNDPROC, AddressOf(WndProcFirst) As LONG_PTR) As WNDPROC
179 End Sub
180
181Private
182 Sub throwIfAlreadyCreated()
183 If hwnd <> 0 Then
184 Throw New System.InvalidOperationException("Window is already created.")
185 End If
186 End Sub
187
188 Sub throwIfNotCreated()
189 If hwnd = 0 Then
190 Throw New System.InvalidOperationException("Window is not already created.")
191 End If
192 End Sub
193
194'--------------------------------
195' ウィンドウプロシージャ
196
197Protected
198 Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
199 If Not ProcessMessage(msg, wp, lp, WndProc) Then
200 WndProc = DefWndProc(msg, wp, lp)
201 End If
202 End Function
203
204 Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
205 If prevWndProc Then
206 DefWndProc = CallWindowProc(prevWndProc, hwnd, msg, wp, lp)
207 Else
208 DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
209 End If
210 End Function
211Protected
212 Function ProcessMessage(msg As DWord, wp As WPARAM, lp As LPARAM, ByRef lr As LRESULT) As Boolean
213 Dim h = Nothing As MessageHandler
214 Dim b = messageMap.TryGetValue(Hex$(msg), h)
215 If b Then
216 If Not IsNothing(h) Then
217 Dim a = New MessageArgs(hwnd, msg, wp, lp)
218 h(This, a)
219 If a.Handled Then
220 lr = a.LResult
221 ProcessMessage = True
222 Exit Function
223 End If
224 End If
225 End If
226 ProcessMessage = False
227 End Function
228Private
229 Static Function makeKeysFormMsg(e As MessageArgs) As Keys
230 Dim t = (e.WParam As DWord) And Keys.KeyCode
231 t Or= (GetKeyState(VK_SHIFT) As Word And &h8000) << 1
232 t Or= (GetKeyState(VK_CONTROL) As Word And &h8000) << 2
233 t Or= (GetKeyState(VK_MENU) As Word And &h8000) << 3
234 makeKeysFormMsg = t As Keys
235 End Function
236
237 Static Function makeMouseEventFromMsg(e As MessageArgs) As MouseArgs
238 Dim wp = e.WParam
239 Dim lp = e.LParam
240
241 /*************************************************/
242 Dim mb As MouseButtons
243 If LOWORD(wp) = 0 Then mb = MouseButtons.None
244 If LOWORD(wp) and MK_LBUTTON Then mb or = MouseButtons.Left
245 If LOWORD(wp) and MK_RBUTTON Then mb or = MouseButtons.Right
246 If LOWORD(wp) and MK_MBUTTON Then mb or = MouseButtons.Middle
247 If LOWORD(wp) and MK_XBUTTON1 Then mb or = MouseButtons.XButton1
248 If LOWORD(wp) and MK_XBUTTON2 Then mb or = MouseButtons.XButton2
249 If LOWORD(wp) and MK_SHIFT Then mb or = MouseButtons.Shift
250 If LOWORD(wp) and MK_CONTROL Then mb or = MouseButtons.Control
251 makeMouseEventFromMsg = New MouseArgs(mb, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
252 /*************************************************/
253
254 'makeMouseEventFromMsg = New MouseArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
255 End Function
256
257Protected
258 /*!
259 @brief 最初にウィンドウプロシージャを使うための前処理を行う関数
260 @date 2008/07/11
261 WndProcFirstを使うときは、この関数を呼んでおく必要がある。
262 */
263 Sub StartWndProc()
264 TlsSetValue(tlsIndex, ObjPtr(This))
265 registerStandardEvent()
266 End Sub
267Private
268 /*!
269 @brief 主なメッセージハンドラの登録を行う関数
270 @date 2008/08/02
271 */
272 Sub registerStandardEvent()
273 AddMessageEvent(WM_ERASEBKGND, AddressOf(OnEraseBackground))
274 Dim md = New MessageHandler(AddressOf(OnMouseDownBase))
275 AddMessageEvent(WM_LBUTTONDOWN, md)
276 AddMessageEvent(WM_RBUTTONDOWN, md)
277 AddMessageEvent(WM_MBUTTONDOWN, md)
278 AddMessageEvent(WM_XBUTTONDOWN, md)
279 Dim mu = New MessageHandler(AddressOf(OnMouseUpBase))
280 AddMessageEvent(WM_LBUTTONUP, mu)
281 AddMessageEvent(WM_RBUTTONUP, mu)
282 AddMessageEvent(WM_MBUTTONUP, mu)
283 AddMessageEvent(WM_XBUTTONUP, mu)
284 Dim mb = New MessageHandler(AddressOf(OnMouseDblClkBase))
285 AddMessageEvent(WM_LBUTTONDBLCLK, mb)
286 AddMessageEvent(WM_RBUTTONDBLCLK, mb)
287 AddMessageEvent(WM_MBUTTONDBLCLK, mb)
288 AddMessageEvent(WM_XBUTTONDBLCLK, mb)
289
290 AddMessageEvent(WM_MOUSEMOVE, AddressOf(OnMouseMoveBase))
291 AddMessageEvent(WM_MOUSELEAVE, AddressOf(OnMouseLeaveBase))
292 AddMessageEvent(WM_MOUSEHOVER, AddressOf(OnMouseHoverBase))
293 AddMessageEvent(WM_PAINT, AddressOf(OnPaintBase))
294 AddMessageEvent(WM_PAINTCLIENT, AddressOf(OnPaintClientBase))
295 AddMessageEvent(WM_KEYDOWN, AddressOf(OnKeyDownBase))
296 AddMessageEvent(WM_CHAR, AddressOf(OnChar))
297 AddMessageEvent(WM_CREATE, AddressOf(OnCreateBase))
298 AddMessageEvent(WM_SIZE, AddressOf(OnSize))
299 End Sub
300
301 Sub OnEraseBackground(sender As Object, e As MessageArgs)
302 Dim a = New PaintBackgroundArgs(e.WParam, e.LParam)
303 e.Handled = e.Handled And OnPaintBackground(a)
304 e.LResult = a.Painted
305 End Sub
306
307 Sub OnMouseDownBase(sender As Object, e As MessageArgs)
308 e.Handled = e.Handled And OnMouseDown(makeMouseEventFromMsg(e))
309 End Sub
310
311 Sub OnMouseUpBase(sender As Object, e As MessageArgs)
312 Dim me = makeMouseEventFromMsg(e)
313 If doubleClickFired = False Then
314 OnClick(Args.Empty)
315 OnMouseClick(me)
316 Else
317 doubleClickFired = False
318 End If
319 e.Handled = e.Handled And OnMouseUp(me)
320 End Sub
321
322 Sub OnMouseDblClkBase(sender As Object, e As MessageArgs)
323 Dim me = makeMouseEventFromMsg(e)
324 doubleClickFired = True
325 OnMouseDown(me)
326 OnDoubleClick(Args.Empty)
327 e.Handled = e.Handled And OnMouseDoubleClick(me)
328 End Sub
329
330 Sub OnMouseMoveBase(sender As Object, e As MessageArgs)
331 Dim me = makeMouseEventFromMsg(e)
332 If mouseEntered = False Then
333 mouseEntered = True
334 OnMouseEnter(me)
335 trackMouseEvent(TME_LEAVE Or TME_HOVER)
336 End If
337 e.Handled = e.Handled And OnMouseMove(me)
338 End Sub
339
340 Sub OnMouseLeaveBase(sender As Object, e As MessageArgs)
341 e.Handled = e.Handled And OnMouseLeave(Args.Empty)
342 mouseEntered = False
343 End Sub
344
345 Sub OnMouseHoverBase(sender As Object, e As MessageArgs)
346 Dim me = makeMouseEventFromMsg(e)
347 e.Handled = e.Handled And OnMouseHover(me)
348 End Sub
349
350 Sub OnPaintBase(sender As Object, e As MessageArgs)
351 If ActiveBasic.IsNothing(paintDC) Then
352 e.Handled = False
353 Else
354 Dim ps As PAINTSTRUCT
355 BeginPaint(hwnd, ps)
356 Try
357 OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
358 Finally
359 EndPaint(hwnd, ps)
360 End Try
361 End If
362 End Sub
363
364 Sub OnPaintClientBase(sender As Object, e As MessageArgs)
365 If ActiveBasic.IsNothing(paintDC) Then
366 e.Handled = False
367 Else
368 OnPaintDC(New PaintDCArgs(e.WParam As HDC, ClientRect))
369 End If
370 End Sub
371
372 Sub OnKeyDownBase(sender As Object, e As MessageArgs)
373 e.Handled = e.Handled And OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
374 End Sub
375
376 Sub OnKeyUpBase(sender As Object, e As MessageArgs)
377 e.Handled = e.Handled And OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
378 End Sub
379
380 Sub OnChar(sender As Object, e As MessageArgs)
381 e.Handled = e.Handled And OnKeyPress(New KeyPressArgs(e.WParam As Char))
382 End Sub
383
384 Sub OnCreateBase(sender As Object, e As MessageArgs)
385 Dim c = New CreateArgs(e.LParam As *CREATESTRUCT)
386 If e.LResult = -1 Then
387 c.Cancel = True
388 End If
389 e.Handled = e.Handled And OnCreate(c)
390 If c.Cancel Then
391 e.LResult = -1
392 Else
393 e.LResult = 0
394 End If
395 End Sub
396
397 Sub OnSize(sender As Object, e As MessageArgs)
398 e.Handled = e.Handled And OnResize(New ResizeArgs(e.WParam, e.LParam))
399 End Sub
400
401 messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageHandler>
402
403Public
404 /*!
405 @biref メッセージイベントハンドラを登録する。
406 @date 2007/12/04
407 */
408 Sub AddMessageEvent(message As DWord, h As MessageHandler)
409 If Not IsNothing(h) Then
410 If IsNothing(messageMap) Then
411 messageMap = New System.Collections.Generic.Dictionary<Object, MessageHandler>
412 End If
413 Dim msg = Hex$(message)
414 Dim m = Nothing As MessageHandler
415 If messageMap.TryGetValue(msg, m) Then
416 messageMap.Item[msg] = m + h
417 Else
418 messageMap.Item[msg] = h
419 End If
420 End If
421 End Sub
422
423 /*!
424 @biref メッセージイベントハンドラ登録を解除する。
425 @date 2007/12/04
426 */
427 Sub RemoveMessageEvent(message As DWord, a As MessageHandler)
428 If Not IsNothing(a) Then
429 If Not IsNothing(messageMap) Then
430 Dim msg = Hex$(message)
431 Dim m = messageMap.Item[msg]
432 If Not IsNothing(m) Then
433 messageMap.Item[msg] = m - a
434 End If
435 End If
436 End If
437 End Sub
438
439'--------------------------------
440' ウィンドウメッセージ処理
441
442
443'--------
444'イベント
445
446#include "ControlEvent.sbp"
447
448'--------------------------------
449' インスタンスメンバ変数
450Private
451 /*!
452 @brief サブクラス化前のウィンドウプロシージャ
453 @date 2008/08/23
454 サブクラス化していなければNULL
455 */
456 prevWndProc As WNDPROC
457 /*!
458 @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ
459 外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。
460 */
461 mouseEntered As Boolean
462 /*!
463 @brief ダブルクリックが起こったかどうかのフラグ
464 Click/MouseClickイベントのために用意している。
465 @date 2008/07/12
466 */
467 doubleClickFired As Boolean
468
469'--------------------------------
470' 初期ウィンドウクラス
471Protected
472 Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
473 Imports System.Runtime.InteropServices
474
475 Dim rThis = FromHWndCore(hwnd)
476 If IsNothing(rThis) Then
477 rThis = _System_PtrObj(TlsGetValue(tlsIndex)) As Control
478 TlsSetValue(tlsIndex, 0)
479 If IsNothing(rThis) Then
480 Goto *InstanceIsNotFound
481 End If
482 ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
483 rThis.AssociateHWnd(hwnd)
484 End If
485 If msg = WM_NCDESTROY Then
486 rThis.UnassociateHWnd()
487 rThis.hwnd = 0
488 End If
489 If msg = WM_DESTROY And IsNothing(rThis.finalDestroy) = False Then
490 Dim f = rThis.finalDestroy
491 f(rThis, Args.Empty)
492 End If
493 WndProcFirst = rThis.WndProc(msg, wp, lp)
494 Exit Function
495
496 *InstanceIsNotFound
497 Dim err = String.Concat("Control.WndProcFirst: The attached instance is not found. msg = &h",
498 Hex$(msg), Ex"\r\n")
499 OutputDebugString(ToTCStr(err))
500 WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
501 End Function
502
503 /*!
504 @brief Controlインスタンスとウィンドウハンドルを結び付ける。
505 @param[in] hwndNew 結び付けるウィンドウハンドル
506 @date 2008/07/16
507 これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなると共に、
508 FromHWndでウィンドウハンドルからControlインスタンスの取得が可能となる。
509 */
510 Sub AssociateHWnd(hwndNew As HWND)
511 SetHWnd(hwndNew)
512 Prop[PropertyInstance] = ObjPtr(This) As HANDLE
513 comImpl.AddRef()
514 End Sub
515
516 /*!
517 @brief オーナーの破棄時にこのControlインスタンスとウィンドウハンドルの結び付けを解除するよう登録する。
518 @param[in] owner 結び付けの解除を連動させるControl
519 @date 2008/07/16
520 ownerのFinalDestoryでこのControlとHWNDとの結び付けを解除する。
521 */
522 Sub RegisterUnassociateHWnd(owner As Control)
523 If IsNothing(owner) = False Then
524 Dim e = New Handler(AddressOf(UnassociateHWndOnEvent))
525 If IsNothing(finalDestroy) Then
526 owner.finalDestroy = e
527 Else
528 owner.finalDestroy += e
529 End If
530 End If
531 End Sub
532
533 Sub UnassociateHWndOnEvent(sender As Object, e As Args)
534 UnassociateHWnd()
535 hwnd = 0
536 End Sub
537
538 Sub UnassociateHWnd()
539 comImpl.Release()
540 End Sub
541
542' Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord
543' Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord
544
545'--------------------------------
546' インタフェース実装
547
548Public
549 Virtual Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT
550 QueryInterfaceImpl = E_NOTIMPL
551 End Function
552
553Private
554 /*!
555 @brief ウィンドウの寿命管理
556 Controlには次のAddRef-Releaseの対がある。
557 @li createImpl - WM_NCDESTROY(ウィンドウプロシージャがWndProcFirstの場合)
558 @li createImpl - UnassociateHWnd←UnassociateHWndOnEvent←RegisterUnassociateHWnd(その他のウィンドウクラスの場合)
559 @li Attach - WM_NCDESTROY(サブクラス化された場合)
560 なお、Control派生クラスをサブクラス化すると、後ろ2つが両方適用される。
561 */
562 comImpl As COM.ComClassDelegationImpl
563
564'--------------------------------
565' その他の補助関数
566Private
567 Function trackMouseEvent(flags As DWord) As BOOL
568 If pTrackMouseEvent <> 0 Then
569 Dim tme As TRACKMOUSEEVENT
570 With tme
571 .cbSize = Len(tme)
572 .dwFlags = flags
573 .hwndTrack = hwnd
574 .dwHoverTime = HOVER_DEFAULT
575 End With
576 trackMouseEvent = pTrackMouseEvent(tme)
577 End If
578 End Function
579
580'--------------------------------
581' 初期化終了関連(特にウィンドウクラス)
582Private
583 'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの
584 Static tlsIndex As DWord
585
586 Static hInstance As HINSTANCE
587 Static atom As ATOM
588 Static hmodComctl As HMODULE
589 Static pTrackMouseEvent As Detail.PTrackMouseEvent
590
591 Static Const WindowClassName = "ActiveBasic.Windows.UI.Control"
592 Static Const PropertyInstance = 0 As ATOM
593Public
594 Static Sub Initialize(hinst As HINSTANCE)
595 tlsIndex = TlsAlloc()
596 If tlsIndex = TLS_OUT_OF_INDEXES Then
597 ThrowWithLastError("Control.Initialize: TlsAlloc failed.")
598 End If
599 hInstance = hinst
600 hmodComctl = LoadLibrary("comctl32.dll")
601 pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent")) As Detail.PTrackMouseEvent
602
603 Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId())
604 PropertyInstance = GlobalAddAtom(ToTCStr(PropertyInstanceString))
605 If PropertyInstance = 0 Then
606 ThrowWithLastError("Control.Initialize: GlobalAddAtom failed.")
607 End If
608
609 Dim wcx As WNDCLASSEX
610 With wcx
611 .cbSize = Len (wcx)
612 .style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS
613 .lpfnWndProc = AddressOf (WndProcFirst)
614 .cbClsExtra = 0
615 .cbWndExtra = 0
616 .hInstance = hinst
617 .hIcon = 0
618 .hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR
619 .hbrBackground = (COLOR_3DFACE + 1) As HBRUSH
620 .lpszMenuName = 0
621 .lpszClassName = ToTCStr(WindowClassName)
622 .hIconSm = 0
623 End With
624 atom = RegisterClassEx(wcx)
625 If atom = 0 Then
626 ThrowWithLastErrorNT("Control.Initialize: RegisterClasseEx failed.")
627 End If
628 End Sub
629
630 Static Sub Uninitialize()
631 If atom <> 0 Then
632 UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance)
633 End If
634 If tlsIndex <> 0 And tlsIndex <> &hffffffff Then
635 TlsFree(tlsIndex)
636 End If
637 If hmodComctl <> 0 Then
638 FreeLibrary(hmodComctl)
639 End If
640 If PropertyInstance <> 0 Then
641 GlobalDeleteAtom(PropertyInstance)
642 End If
643 End Sub
644End Class
645
646/*!
647@brief WM_COMMANDで通知を行うコントロールの基底クラス
648@date 2008/08/28
649@auther Egtra
650親がWM_COMMANDを受け取ったら、RaiseCommandEventを呼ぶことを意図している。
651(Formで実装済み)
652*/
653Class WmCommandControl
654 Inherits Control
655Public
656 Abstract Function RaiseCommandEvent(notificationCode As Word) As Boolean
657End Class
658
659End Namespace 'UI
660End Namespace 'Widnows
661End Namespace 'ActiveBasic
Note: See TracBrowser for help on using the repository browser.