1 | 'Classes/ActiveBasic/Windows/UI/Control.ab
|
---|
2 |
|
---|
3 | #require <Classes/ActiveBasic/Windows/UI/Forms/EventArgs.ab>
|
---|
4 |
|
---|
5 | Namespace ActiveBasic
|
---|
6 | Namespace Windows
|
---|
7 | Namespace UI
|
---|
8 | Namespace Forms
|
---|
9 |
|
---|
10 | 'Namespace Detail
|
---|
11 | ' TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL
|
---|
12 | 'End Namespace
|
---|
13 |
|
---|
14 | Class Control
|
---|
15 | Public
|
---|
16 | Sub Control()
|
---|
17 | End Sub
|
---|
18 |
|
---|
19 | Virtual Sub ~Control()
|
---|
20 | End Sub
|
---|
21 |
|
---|
22 | Function Handle() As HWND
|
---|
23 | Handle = hwnd
|
---|
24 | End Function
|
---|
25 |
|
---|
26 | Static Function FromHWnd(hwnd As HWND) As Control
|
---|
27 | FromHWnd = Nothing
|
---|
28 | If IsWindow(hwnd) Then
|
---|
29 | FromHWnd = FromHWndCore(hwnd)
|
---|
30 | End If
|
---|
31 | End Function
|
---|
32 |
|
---|
33 | Private
|
---|
34 | Static Function FromHWndCore(hwnd As HWND) As Control
|
---|
35 | If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then
|
---|
36 | Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR
|
---|
37 | If gchValue <> 0 Then
|
---|
38 | Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue)
|
---|
39 | FromHWndCore = gch.Target As Control
|
---|
40 | Exit Function
|
---|
41 | End If
|
---|
42 | End If
|
---|
43 | End Function
|
---|
44 |
|
---|
45 | '--------------------------------
|
---|
46 | ' ウィンドウ作成
|
---|
47 | /*
|
---|
48 | Function Create(
|
---|
49 | parent As HWND,
|
---|
50 | rect As RECT,
|
---|
51 | name As String,
|
---|
52 | style As DWord,
|
---|
53 | exStyle = 0 As DWord,
|
---|
54 | menu = 0 As HMENU) As HWND
|
---|
55 | */
|
---|
56 |
|
---|
57 | Public
|
---|
58 | Function Create() As Boolean
|
---|
59 | Dim cs As CREATESTRUCT
|
---|
60 | cs.hInstance = hInstance
|
---|
61 | cs.lpszClass = (atom As ULONG_PTR) As LPCTSTR
|
---|
62 | GetCreateStruct(cs)
|
---|
63 | Create = createImpl(cs)
|
---|
64 | End Function
|
---|
65 |
|
---|
66 | Protected
|
---|
67 | Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
|
---|
68 |
|
---|
69 | Function createImpl(ByRef cs As CREATESTRUCT) As Boolean
|
---|
70 | Imports System.Runtime.InteropServices
|
---|
71 |
|
---|
72 | Dim gch = GCHandle.Alloc(This)
|
---|
73 | TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr)
|
---|
74 |
|
---|
75 | StartWndProc()
|
---|
76 |
|
---|
77 | With cs
|
---|
78 | Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
|
---|
79 | .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
|
---|
80 | createImpl = hwnd <> 0
|
---|
81 | End With
|
---|
82 | End Function
|
---|
83 |
|
---|
84 | '--------------------------------
|
---|
85 | ' ウィンドウプロシージャ
|
---|
86 | 'Protected
|
---|
87 | Public
|
---|
88 | Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
|
---|
89 | Dim h = Nothing As MessageEventHandler
|
---|
90 | Dim b = messageMap.TryGetValue(Hex$(msg), h)
|
---|
91 | If b Then
|
---|
92 | If Not IsNothing(h) Then
|
---|
93 | Dim a = New MessageEventArgs(hwnd, msg, wp, lp)
|
---|
94 | h(This, a)
|
---|
95 | WndProc = a.LResult
|
---|
96 | Exit Function
|
---|
97 | End If
|
---|
98 | End If
|
---|
99 | WndProc = DefWndProc(msg, wp, lp)
|
---|
100 | End Function
|
---|
101 |
|
---|
102 | Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
|
---|
103 | DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
|
---|
104 | End Function
|
---|
105 |
|
---|
106 | Private
|
---|
107 | Static Function makeKeysFormMsg(e As MessageEventArgs) As Keys
|
---|
108 | Dim t As DWord
|
---|
109 | t = e.WParam And Keys.KeyCode
|
---|
110 | t Or= (GetKeyState(VK_SHIFT) As Word And &h8000) << 1
|
---|
111 | t Or= (GetKeyState(VK_CONTROL) As Word And &h8000) << 2
|
---|
112 | t Or= (GetKeyState(VK_MENU) As Word And &h8000) << 3
|
---|
113 | makeKeysFormMsg = t As Keys
|
---|
114 | End Function
|
---|
115 |
|
---|
116 | Static Function makeMouseEventFromMsg(e As MessageEventArgs) As MouseEventArgs
|
---|
117 | Dim wp = e.WParam
|
---|
118 | Dim lp = e.LParam
|
---|
119 | makeMouseEventFromMsg = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
|
---|
120 | End Function
|
---|
121 |
|
---|
122 | /*!
|
---|
123 | @brief 最初にウィンドウプロシージャが呼ばれるときに実行される関数
|
---|
124 | ここでは、主なメッセージハンドラの登録を行っている。
|
---|
125 | @date 2008/07/11
|
---|
126 | */
|
---|
127 | Sub StartWndProc()
|
---|
128 | Dim t = This '#177対策
|
---|
129 | AddMessageEvent(WM_ERASEBKGND, AddressOf(t.OnEraseBackground))
|
---|
130 | Dim md = New MessageEventHandler(AddressOf(t.OnMouseDownBase))
|
---|
131 | AddMessageEvent(WM_LBUTTONDOWN, md)
|
---|
132 | AddMessageEvent(WM_RBUTTONDOWN, md)
|
---|
133 | AddMessageEvent(WM_MBUTTONDOWN, md)
|
---|
134 | AddMessageEvent(WM_XBUTTONDOWN, md)
|
---|
135 | Dim mu = New MessageEventHandler(AddressOf(t.OnMouseUpBase))
|
---|
136 | AddMessageEvent(WM_LBUTTONUP, mu)
|
---|
137 | AddMessageEvent(WM_RBUTTONUP, mu)
|
---|
138 | AddMessageEvent(WM_MBUTTONUP, mu)
|
---|
139 | AddMessageEvent(WM_XBUTTONUP, mu)
|
---|
140 | Dim mb = New MessageEventHandler(AddressOf(t.OnMouseDblClkBase))
|
---|
141 | AddMessageEvent(WM_LBUTTONDBLCLK, mu)
|
---|
142 | AddMessageEvent(WM_RBUTTONDBLCLK, mu)
|
---|
143 | AddMessageEvent(WM_MBUTTONDBLCLK, mu)
|
---|
144 | AddMessageEvent(WM_XBUTTONDBLCLK, mu)
|
---|
145 |
|
---|
146 | AddMessageEvent(WM_MOUSELEAVE, AddressOf(t.OnMouseLeaveBase))
|
---|
147 | AddMessageEvent(WM_PAINT, AddressOf(t.OnPaintBase))
|
---|
148 | AddMessageEvent(WM_KEYDOWN, AddressOf(t.OnKeyDownBase))
|
---|
149 | ' AddMessageEvent(WM_CHAR, AddressOf(t.OnChar))
|
---|
150 | AddMessageEvent(WM_CREATE, AddressOf(t.OnCreateBase))
|
---|
151 | End Sub
|
---|
152 |
|
---|
153 | Sub OnEraseBackground(sender As Object, e As MessageEventArgs)
|
---|
154 | Dim rc As RECT
|
---|
155 | Dim r = GetClientRect(hwnd, rc)
|
---|
156 | FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
|
---|
157 | e.LResult = TRUE
|
---|
158 | End Sub
|
---|
159 |
|
---|
160 | Sub OnMouseDownBase(sender As Object, e As MessageEventArgs)
|
---|
161 | OnMouseDown(makeMouseEventFromMsg(e))
|
---|
162 | End Sub
|
---|
163 |
|
---|
164 | Sub OnMouseUpBase(sender As Object, e As MessageEventArgs)
|
---|
165 | Dim me = makeMouseEventFromMsg(e)
|
---|
166 | If doubleClickFired = False Then
|
---|
167 | ' OnClick(System.EventArgs.Empty)
|
---|
168 | OnMouseClick(me)
|
---|
169 | doubleClickFired = False
|
---|
170 | End If
|
---|
171 | OnMouseUp(me)
|
---|
172 | End Sub
|
---|
173 |
|
---|
174 | Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs)
|
---|
175 | Dim me = makeMouseEventFromMsg(e)
|
---|
176 | doubleClickFired = True
|
---|
177 | OnMouseDown(me)
|
---|
178 | ' OnDoubleClick(System.EventArgs.Empty)
|
---|
179 | OnMouseDoubleClick(me)
|
---|
180 | End Sub
|
---|
181 |
|
---|
182 | Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs)
|
---|
183 | Dim me = makeMouseEventFromMsg(e)
|
---|
184 | If mouseEntered Then
|
---|
185 | OnMouseMove(me)
|
---|
186 | Else
|
---|
187 | mouseEntered = True
|
---|
188 | OnMouseEnter(me)
|
---|
189 | End If
|
---|
190 | End Sub
|
---|
191 |
|
---|
192 | Sub OnMouseLeaveBase(sender As Object, e As MessageEventArgs)
|
---|
193 | Dim me = makeMouseEventFromMsg(e)
|
---|
194 | OnMouseLeave(me)
|
---|
195 | mouseEntered = False
|
---|
196 | End Sub
|
---|
197 |
|
---|
198 | Sub OnPaintBase(sender As Object, e As MessageEventArgs)
|
---|
199 | Dim ps As PAINTSTRUCT
|
---|
200 | BeginPaint(hwnd, ps)
|
---|
201 | Try
|
---|
202 | OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
|
---|
203 | Finally
|
---|
204 | EndPaint(hwnd, ps)
|
---|
205 | End Try
|
---|
206 | End Sub
|
---|
207 |
|
---|
208 | Sub OnKeyDownBase(sender As Object, e As MessageEventArgs)
|
---|
209 | OnKeyDown(New KeyEventArgs(makeKeysFormMsg(e)))
|
---|
210 | End Sub
|
---|
211 |
|
---|
212 | Sub OnKeyUpBase(sender As Object, e As MessageEventArgs)
|
---|
213 | OnKeyUp(New KeyEventArgs(makeKeysFormMsg(e)))
|
---|
214 | End Sub
|
---|
215 |
|
---|
216 | ' コメントアウト解除のときはStartWndProcのコメントアウト解除も忘れないこと
|
---|
217 | ' Sub OnChar(sender As Object, e As MessageEventArgs)
|
---|
218 | ' OnKeyPress(New KeyPressEventArgs(e.WParam As Char))
|
---|
219 | ' End Sub
|
---|
220 |
|
---|
221 | Sub OnCreateBase(sender As Object, e As MessageEventArgs)
|
---|
222 | OnCreate(New CreateEventArgs(e.LParam As *CREATESTRUCT))
|
---|
223 | End Sub
|
---|
224 |
|
---|
225 | messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageEventHandler>
|
---|
226 |
|
---|
227 | Public
|
---|
228 | /*!
|
---|
229 | @biref メッセージイベントハンドラを登録する。
|
---|
230 | @date 2007/12/04
|
---|
231 | */
|
---|
232 | Sub AddMessageEvent(message As DWord, h As MessageEventHandler)
|
---|
233 | If Not IsNothing(h) Then
|
---|
234 | If IsNothing(messageMap) Then
|
---|
235 | messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
|
---|
236 | End If
|
---|
237 | Dim msg = Hex$(message)
|
---|
238 | Dim m = Nothing As MessageEventHandler
|
---|
239 | If messageMap.TryGetValue(msg, m) Then
|
---|
240 | messageMap.Item[msg] = m + h
|
---|
241 | Else
|
---|
242 | messageMap.Item[msg] = h
|
---|
243 | End If
|
---|
244 | End If
|
---|
245 | End Sub
|
---|
246 |
|
---|
247 | /*!
|
---|
248 | @biref メッセージイベントハンドラ登録を解除する。
|
---|
249 | @date 2007/12/04
|
---|
250 | */
|
---|
251 | Sub RemoveMessageEvent(message As DWord, a As MessageEventHandler)
|
---|
252 | If Not IsNothing(a) Then
|
---|
253 | If Not IsNothing(messageMap) Then
|
---|
254 | Dim msg = Nothing As Object : msg = New System.UInt32(message)
|
---|
255 | Dim m = messageMap.Item[msg]
|
---|
256 | If Not IsNothing(m) Then
|
---|
257 | messageMap.Item[msg] = m - a
|
---|
258 | End If
|
---|
259 | End If
|
---|
260 | End If
|
---|
261 | End Sub
|
---|
262 |
|
---|
263 | '--------------------------------
|
---|
264 | ' ウィンドウメッセージ処理
|
---|
265 |
|
---|
266 |
|
---|
267 | '--------
|
---|
268 | 'イベント
|
---|
269 |
|
---|
270 | #include "ControlEvent.sbp"
|
---|
271 |
|
---|
272 | '--------------------------------
|
---|
273 | ' インスタンスメンバ変数
|
---|
274 | Private
|
---|
275 | hwnd As HWND
|
---|
276 | /*!
|
---|
277 | @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ
|
---|
278 | 外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。
|
---|
279 | */
|
---|
280 | mouseEntered As Boolean
|
---|
281 | /*!
|
---|
282 | @brief ダブルクリックが起こったかどうかのフラグ
|
---|
283 | Click/MouseClickイベントのために用意している。
|
---|
284 | @date 2008/07/12
|
---|
285 | */
|
---|
286 | doubleClickFired As Boolean
|
---|
287 |
|
---|
288 | '--------------------------------
|
---|
289 | ' 初期ウィンドウクラス
|
---|
290 | Private
|
---|
291 | Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
|
---|
292 | Imports System.Runtime.InteropServices
|
---|
293 |
|
---|
294 | Dim rThis = Control.FromHWndCore(hwnd)
|
---|
295 | If IsNothing(rThis) Then
|
---|
296 | Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR
|
---|
297 | TlsSetValue(tlsIndex, 0)
|
---|
298 | If gchValue = 0 Then
|
---|
299 | Goto *InstanceIsNotFound
|
---|
300 | End If
|
---|
301 | Dim gch = GCHandle.FromIntPtr(gchValue)
|
---|
302 | rThis = gch.Target As Control
|
---|
303 | ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
|
---|
304 |
|
---|
305 | If IsNothing(rThis) Then
|
---|
306 | Goto *InstanceIsNotFound
|
---|
307 | End If
|
---|
308 | rThis.hwnd = hwnd
|
---|
309 | SetProp(hwnd, PropertyInstance As ULONG_PTR As PCSTR, gchValue As HANDLE)
|
---|
310 | End If
|
---|
311 | WndProcFirst = rThis.WndProc(msg, wp, lp)
|
---|
312 | If msg = WM_NCDESTROY Then
|
---|
313 | Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR
|
---|
314 | If gchValue <> 0 Then
|
---|
315 | Dim gch = GCHandle.FromIntPtr(gchValue)
|
---|
316 | gch.Free()
|
---|
317 | End If
|
---|
318 | End If
|
---|
319 |
|
---|
320 | Exit Function
|
---|
321 |
|
---|
322 | *InstanceIsNotFound
|
---|
323 | OutputDebugString("ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found.")
|
---|
324 | WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
|
---|
325 | End Function
|
---|
326 |
|
---|
327 | ' Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord
|
---|
328 | ' Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord
|
---|
329 |
|
---|
330 | '--------------------------------
|
---|
331 | ' その他の補助関数
|
---|
332 | Private
|
---|
333 | ' Sub tracMouseEvent()
|
---|
334 | /* If pTrackMouseEvent <> 0 Then
|
---|
335 | Dim tme As TRACKMOUSEEVENT
|
---|
336 | With tme
|
---|
337 | .cbSize = Len(tme)
|
---|
338 | .dwFlags = TME_HOVER Or TME_LEAVE
|
---|
339 | .hwndTrack = wnd
|
---|
340 | .dwHoverTime = HOVER_DEFAULT
|
---|
341 | End With
|
---|
342 | pTrackMouseEvent(tme)
|
---|
343 | End If
|
---|
344 | */ 'End Sub
|
---|
345 |
|
---|
346 | '--------------------------------
|
---|
347 | ' 初期化終了関連(特にウィンドウクラス)
|
---|
348 | Private
|
---|
349 | 'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの
|
---|
350 | Static tlsIndex As DWord
|
---|
351 |
|
---|
352 | Static hInstance As HINSTANCE
|
---|
353 | Static atom As ATOM
|
---|
354 | Static hmodComctl As HMODULE
|
---|
355 | ' Static pTrackMouseEvent As PTrackMouseEvent
|
---|
356 |
|
---|
357 | Static Const WindowClassName = "ActiveBasic.Windows.UI.Control"
|
---|
358 | Static Const PropertyInstance = 0 As ATOM
|
---|
359 | Public
|
---|
360 | Static Sub Initialize(hinst As HINSTANCE)
|
---|
361 | tlsIndex = TlsAlloc()
|
---|
362 | hInstance = hinst
|
---|
363 | ' hmodComctl = LoadLibrary("comctl32.dll")
|
---|
364 | ' pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent"))
|
---|
365 |
|
---|
366 | Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId())
|
---|
367 | PropertyInstance = GlobalAddAtom(ToTCStr(PropertyInstanceString))
|
---|
368 |
|
---|
369 | Dim wcx As WNDCLASSEX
|
---|
370 | With wcx
|
---|
371 | .cbSize = Len (wcx)
|
---|
372 | .style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS
|
---|
373 | .lpfnWndProc = AddressOf (WndProcFirst)
|
---|
374 | .cbClsExtra = 0
|
---|
375 | .cbWndExtra = 0
|
---|
376 | .hInstance = hinst
|
---|
377 | .hIcon = 0
|
---|
378 | .hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR
|
---|
379 | .hbrBackground = 0
|
---|
380 | .lpszMenuName = 0
|
---|
381 | .lpszClassName = ToTCStr(WindowClassName)
|
---|
382 | .hIconSm = 0
|
---|
383 | End With
|
---|
384 | atom = RegisterClassEx(wcx)
|
---|
385 | If atom = 0 Then
|
---|
386 | Dim buf[1023] As TCHAR
|
---|
387 | wsprintf(buf, Ex"ActiveBasic.Windows.UI.Control.Control: RegisterClasseEx failed. Error code: &h%08X\r\n", GetLastError())
|
---|
388 | OutputDebugString(buf)
|
---|
389 | Debug
|
---|
390 | ExitThread(0)
|
---|
391 | End If
|
---|
392 | End Sub
|
---|
393 |
|
---|
394 | Static Sub Uninitialize()
|
---|
395 | If atom <> 0 Then
|
---|
396 | UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance)
|
---|
397 | End If
|
---|
398 | If tlsIndex <> 0 And tlsIndex <> &hffffffff Then
|
---|
399 | TlsFree(tlsIndex)
|
---|
400 | End If
|
---|
401 | ' If hmodComctl <> 0 Then
|
---|
402 | ' FreeLibrary(hmodComctl)
|
---|
403 | ' End If
|
---|
404 | If PropertyInstance <> 0 Then
|
---|
405 | GlobalDeleteAtom(PropertyInstance)
|
---|
406 | End If
|
---|
407 | End Sub
|
---|
408 |
|
---|
409 | End Class
|
---|
410 |
|
---|
411 | Class Form '仮
|
---|
412 | Inherits Control
|
---|
413 | Protected
|
---|
414 | Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
|
---|
415 | With cs
|
---|
416 | .lpCreateParams = 0
|
---|
417 | '.hInstance
|
---|
418 | .hMenu = 0
|
---|
419 | .hwndParent = 0
|
---|
420 | .cy = CW_USEDEFAULT
|
---|
421 | .cx = CW_USEDEFAULT
|
---|
422 | .y = CW_USEDEFAULT
|
---|
423 | .x = CW_USEDEFAULT
|
---|
424 | .style = WS_OVERLAPPEDWINDOW
|
---|
425 | .lpszName = ""
|
---|
426 | '.lpszClass
|
---|
427 | .dwExStyle = 0
|
---|
428 | End With
|
---|
429 | End Sub
|
---|
430 | Public
|
---|
431 |
|
---|
432 | Override Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
|
---|
433 | WndProc = 0
|
---|
434 | Select Case msg
|
---|
435 | Case Else
|
---|
436 | WndProc = Super.WndProc(msg, wp, lp)
|
---|
437 | End Select
|
---|
438 | End Function
|
---|
439 | End Class
|
---|
440 |
|
---|
441 | End Namespace 'Forms
|
---|
442 | End Namespace 'UI
|
---|
443 | End Namespace 'Widnows
|
---|
444 | End Namespace 'ActiveBasic
|
---|
445 |
|
---|
446 |
|
---|
447 | '----------
|
---|
448 | 'テスト実行用
|
---|
449 |
|
---|
450 | Imports ActiveBasic.Windows.UI.Forms
|
---|
451 |
|
---|
452 | 'OleInitialize()
|
---|
453 | Control.Initialize(GetModuleHandle(0))
|
---|
454 |
|
---|
455 | Class MyForm
|
---|
456 | Inherits Form
|
---|
457 | Public
|
---|
458 | Sub t()
|
---|
459 | Dim f = This
|
---|
460 | f.AddMessageEvent(WM_DESTROY, AddressOf (f.Destory))
|
---|
461 | f.AddPaintDC(AddressOf (f.Paint))
|
---|
462 | End Sub
|
---|
463 |
|
---|
464 | Sub Destory(sender As Object, e As EventArgs)
|
---|
465 | OutputDebugString(Ex"Destory\r\n")
|
---|
466 | PostQuitMessage(0)
|
---|
467 | End Sub
|
---|
468 |
|
---|
469 | Sub Paint(sender As Object, e As PaintDCEventArgs)
|
---|
470 | TextOut(e.Handle, 10, 10, "Hello world!", 12)
|
---|
471 | End Sub
|
---|
472 | End Class
|
---|
473 |
|
---|
474 | Dim f = New MyForm
|
---|
475 | f.t()
|
---|
476 | f.Create()
|
---|
477 | ShowWindow(f.Handle, SW_SHOW)
|
---|
478 |
|
---|
479 | Dim m As MSG
|
---|
480 | Do
|
---|
481 | Dim ret = GetMessage(m, 0, 0, 0)
|
---|
482 | If ret = 0 Then
|
---|
483 | Exit Do
|
---|
484 | ElseIf ret = -1 Then
|
---|
485 | ExitProcess(-1)
|
---|
486 | End If
|
---|
487 |
|
---|
488 | TranslateMessage(m)
|
---|
489 | DispatchMessage(m)
|
---|
490 | Loop
|
---|
491 |
|
---|
492 | f = Nothing
|
---|
493 | System.GC.Collect()
|
---|
494 |
|
---|
495 | Control.Uninitialize()
|
---|
496 | 'OleUninitialize()
|
---|
497 |
|
---|
498 | End
|
---|