Changeset 559 for trunk/ab5.0/ablib/src/Classes/ActiveBasic
- Timestamp:
- Jul 21, 2008, 1:26:05 AM (16 years ago)
- Location:
- trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Application.ab
r551 r559 20 20 */ 21 21 Static Sub Run(form As Form) 22 f.Show(SW_SHOW)23 22 If IsNothing(form) = False Then 23 form.Show(SW_SHOW) 24 form.Update() 24 25 form.AddMessageEvent(WM_DESTROY, AddressOf(Application.OnMainFormClosed)) 25 26 End If … … 34 35 DispatchMessage(m) 35 36 Loop 36 ' OnThraedExit(EventArgs.Empty) 37 37 38 End Sub 38 39 … … 55 56 End Sub 56 57 57 '#include "ApplicationEvent.sbp" 58 /*! 59 @brief メッセージキューに溜まったメッセージを処理する。 60 @date 2008/07/18 61 @author Egtra 62 ここのコードから改変。 63 http://www.activebasic.com/forum/viewtopic.php?t=426 64 */ 65 Static Sub DoEvents() 66 Dim msg As MSG 67 While PeekMessage(msg, 0, 0, 0, PM_REMOVE) <> FALSE 68 Select Case msg.message 69 Case WM_QUIT 70 PostQuitMessage(0) 'Run()で捕まえてくれるようPostしなおす。 71 Case Else 72 TranslateMessage(msg) 73 DispatchMessage(msg) 74 End Select 75 Wend 76 End Sub 77 78 #include "ApplicationEvent.sbp" 58 79 59 80 Private 60 81 Static Sub OnMainFormClosed(sender As Object, e As Args) 82 OnThreadExit(Args.Empty) 61 83 ExitThread() 62 84 End Sub 63 64 main As Form65 85 End Class 66 86 -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ApplicationEvent.sbp
r551 r559 1 1 Public 2 S ub AddThreadExit(h As Handler)2 Static Sub AddThreadExit(h As Handler) 3 3 If IsNothing(threadExit) Then 4 4 threadExit = h … … 7 7 End If 8 8 End Sub 9 S ub RemoveThreadExit(h As Handler)9 Static Sub RemoveThreadExit(h As Handler) 10 10 If Not IsNothing(threadExit) Then 11 11 threadExit -= h … … 13 13 End Sub 14 14 Protected 15 S ub OnThreadExit(e As Args)15 Static Sub OnThreadExit(e As Args) 16 16 If Not IsNothing(threadExit) Then 17 17 threadExit(This, e) … … 19 19 End Sub 20 20 Private 21 threadExit As Handler21 Static threadExit As Handler 22 22 -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab
r551 r559 91 91 Imports System.Runtime.InteropServices 92 92 93 If hwnd <> 0 Then 94 Throw New System.InvalidOperationException("Window already created.") 95 End If 96 93 97 Dim gch = GCHandle.Alloc(This) 94 98 TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr) … … 101 105 .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams) 102 106 If hwnd = 0 Then 107 Debug 103 108 ActiveBasic.Windows.ThrowByWindowsError(GetLastError()) 104 109 End If … … 251 256 252 257 Sub OnCreateBase(sender As Object, e As MessageArgs) 253 'OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))258 OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT)) 254 259 End Sub 255 260 … … 333 338 ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき 334 339 335 If AssociateHWnd(gch, hwnd) = False Then 336 Goto *InstanceIsNotFound 337 End If 340 AssociateHWnd(gch, hwnd) 338 341 End If 339 342 If msg = WM_NCDESTROY Then … … 349 352 350 353 *InstanceIsNotFound 351 OutputDebugString(Ex"ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found.\r\n") 354 Dim err = "ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found. msg = &h" _ 355 + Hex$(msg) + Ex"\r\n" 356 OutputDebugString(ToTCStr(err)) 352 357 WndProcFirst = DefWindowProc(hwnd, msg, wp, lp) 353 358 End Function … … 360 365 これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなる。 361 366 */ 362 Static Function AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND) As Boolean367 Static Sub AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND) 363 368 Imports System.Runtime.InteropServices 364 369 Dim rThis = gch.Target As Control 365 370 If IsNothing(rThis) Then 366 Exit Function371 Exit Sub 367 372 End If 368 373 rThis.hwnd = hwnd 369 374 rThis.Prop[PropertyInstance] = GCHandle.ToIntPtr(gch) As HANDLE 370 End Function375 End Sub 371 376 372 377 /*! -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEvent.sbp
r551 r559 328 328 Private 329 329 keyPress As KeyPressHandler 330 /* 330 331 331 Public 332 332 Sub AddCreate(h As CreateHandler) … … 372 372 Private 373 373 destroy As Handler 374 */ 374 -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Form.ab
r551 r559 45 45 End Namespace 'Widnows 46 46 End Namespace 'ActiveBasic 47 48 '----------49 'テスト実行用50 51 #require <Classes/ActiveBasic/Windows/UI/Application.ab>52 #require <Classes/ActiveBasic/Windows/UI/Button.ab>53 54 Imports ActiveBasic.Windows.UI55 56 'OleInitialize()57 Control.Initialize(GetModuleHandle(0))58 59 Sub Paint(sender As Object, e As PaintDCArgs)60 TextOut(e.Handle, 10, 10, "Hello world!", 12)61 End Sub62 63 Class MyForm64 Inherits Form65 Public66 Sub MyForm()67 AddPaintDC(AddressOf (Paint))68 AddMouseClick(AddressOf (Mouse))69 s = "aaa"70 End Sub71 72 ' Sub Paint(sender As Object, e As PaintDCArgs)73 ' TextOut(e.Handle, 10, 10, ToTCStr(s), s.Length)74 ' End Sub75 76 Sub Mouse(sender As Object, e As MouseArgs)77 Invalidate()78 End Sub79 80 Sub OnClick(sender As Object, e As Args)81 OutputDebugString(Ex"====OnClick====\r\n")82 End Sub83 84 s As String85 End Class86 87 Dim f = New MyForm88 f.Create()89 f.Text = "Hello"90 91 Dim b = New Button92 b.Create(f)93 b.Move(50, 50, 100, 100)94 b.Text = "Ok"95 b.AddClick(AddressOf(f.OnClick))96 97 Application.Run(f)98 f = Nothing99 System.GC.Collect()100 101 Control.Uninitialize()102 'OleUninitialize()103 104 End -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/MakeControlEventHandler.ab
r551 r559 17 17 End Function 18 18 19 Sub OutputEventHandlerCode(out As TextWriter, eventName As String, argBase As String, comment As String )19 Sub OutputEventHandlerCode(out As TextWriter, eventName As String, argBase As String, comment As String, isStatic As Boolean) 20 20 Dim eventMember = EventNameToMemberVariableName(eventName) 21 21 Dim handlerType = argBase & "Handler" 22 22 Dim argsType = argBase & "Args" 23 Dim staticKeyword = Nothing As String 24 If isStatic Then staticKeyword = "Static " 23 25 out.WriteLine("Public") 24 26 ' out.WriteLine(Ex"\t/*!") 25 27 ' out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを追加する") 26 28 ' out.WriteLine(Ex"\t*/") 27 out.WriteLine(Ex"\t Sub Add" & eventName & "(h As " & handlerType & ")")29 out.WriteLine(Ex"\t" & staticKeyword & "Sub Add" & eventName & "(h As " & handlerType & ")") 28 30 out.WriteLine(Ex"\t\tIf IsNothing(" & eventMember & ") Then") 29 31 out.WriteLine(Ex"\t\t\t" & eventMember & " = h") … … 35 37 ' out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを削除する") 36 38 ' out.WriteLine(Ex"\t*/") 37 out.WriteLine(Ex"\t Sub Remove" & eventName & "(h As " & handlerType & ")")39 out.WriteLine(Ex"\t" & staticKeyword & "Sub Remove" & eventName & "(h As " & handlerType & ")") 38 40 out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then") 39 41 out.WriteLine(Ex"\t\t\t" & eventMember & " -= h") … … 44 46 ' out.WriteLine(Ex"\t@brief " & comment) 45 47 ' out.WriteLine(Ex"\t*/") 46 out.WriteLine(Ex"\t Sub On" & eventName & "(e As " & argsType & ")")48 out.WriteLine(Ex"\t" & staticKeyword & "Sub On" & eventName & "(e As " & argsType & ")") 47 49 out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then") 48 50 out.WriteLine(Ex"\t\t\t" & eventMember & "(This, e)") … … 50 52 out.WriteLine(Ex"\tEnd Sub") 51 53 out.WriteLine("Private") 52 out.WriteLine(Ex"\t" & eventMember & " As " & handlerType)54 out.WriteLine(Ex"\t" & staticKeyword & eventMember & " As " & handlerType) 53 55 out.WriteLine() 54 56 End Sub … … 57 59 ' "ウィンドウの描画が必要なときに呼び出されます。") 58 60 59 Sub MakeControlEvent(t As String )61 Sub MakeControlEvent(t As String, isStatic = False As Boolean) 60 62 Dim event As String, handler As String, comment As String 61 63 Dim n As DWord, i As DWord … … 70 72 Dim a = ActiveBasic.Strings.Detail.Split(s, 9) 'Tab 71 73 If a.Count >= 3 Then 72 OutputEventHandlerCode(out, a[0], a[1], a[2] )74 OutputEventHandlerCode(out, a[0], a[1], a[2], isStatic) 73 75 End If 74 76 Loop … … 79 81 MakeControlEvent("Control") 80 82 MakeControlEvent("Form") 81 MakeControlEvent("Application" )83 MakeControlEvent("Application", True) 82 84 End -
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Windows.ab
r303 r559 47 47 End Namespace 48 48 49 50 /*! 51 @brief Windows/COMのエラーを伝える例外クラス 52 @date 2008/07/13 53 @auther Egtra 54 */ 55 Class WindowsException 56 Inherits System.Exception 57 Public 58 /*! 59 @biref コンストラクタ 60 */ 61 Sub WindowsException() 62 Exception() 63 HResult = E_FAIL 64 End Sub 65 /*! 66 @biref コンストラクタ 67 @param[in] hr エラー値 68 */ 69 Sub WindowsException(hr As HRESULT) 70 Exception(hresultToString(hr)) 71 HResult = hr 72 End Sub 73 /*! 74 @biref コンストラクタ 75 @param[in] message エラーメッセージ 76 */ 77 Sub WindowsException(message As String) 78 Exception(message) 79 HResult = E_FAIL 80 End Sub 81 /*! 82 @biref コンストラクタ 83 @param[in] hr エラー値 84 @param[in] message エラーメッセージ 85 */ 86 Sub WindowsException(hr As HRESULT, message As String) 87 Exception(message) 88 HResult = hr 89 End Sub 90 /*! 91 @biref コンストラクタ 92 @param[in] message エラーメッセージ 93 @param[in] innerException 内部例外 94 */ 95 Sub WindowsException(message As String, innerException As Exception) 96 Exception(message, innerException) 97 HResult = E_FAIL 98 End Sub 99 Private 100 Static Function hresultToString(hr As HRESULT) As String 101 Dim pszMsg As PCSTR 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) 104 If pszMsg <> 0 Then 105 hresultToString = New String(pszMsg) 106 LocalFree(pszMsg) 107 End If 108 End Function 109 End Class 110 111 /*! 112 @brief GetLastErrorのエラー値を基に例外を投げる。 113 @date 2008/07/13 114 @param[in] dwErrorCode Win32エラーコード 115 @throw WindowsException 常に投げられる。 116 @auther Egtra 117 */ 118 Sub ThrowByWindowsError(dwErrorCode As DWord) 119 Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode)) 120 End Sub 121 122 /*! 123 @brief HRESULT値を基に例外を投げる。 124 @date 2008/07/13 125 @param[in] hr HRESULT値 126 @throw WindowsException FAILED(hr)が真の場合 127 @auther Egtra 128 hrが成功値 (FAILED(hr) = False) の場合、この関数は何も行わない。 129 */ 130 Sub ThrowByHResult(hr As HRESULT) 131 If FAILED(hr) Then 132 Throw New WindowsException(hr) 133 End If 134 End Sub 135 49 136 End Namespace 'Widnows 50 137 End Namespace 'ActiveBasic
Note:
See TracChangeset
for help on using the changeset viewer.