Ignore:
Timestamp:
Jul 21, 2008, 1:26:05 AM (16 years ago)
Author:
イグトランス (egtra)
Message:

UI_Sampleの追加。イベントのコメントアウト解除。Form.abからテスト部分を除去。Application.DoEventsを実装。MakeControlEventHandlerを静的メンバのイベント対応へ。WindowsExceptionの追加。

Location:
trunk/ab5.0/ablib/src/Classes
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Application.ab

    r551 r559  
    2020    */
    2121    Static Sub Run(form As Form)
    22         f.Show(SW_SHOW)
    2322        If IsNothing(form) = False Then
     23            form.Show(SW_SHOW)
     24            form.Update()
    2425            form.AddMessageEvent(WM_DESTROY, AddressOf(Application.OnMainFormClosed))
    2526        End If
    … …  
    3435            DispatchMessage(m)
    3536        Loop
    36 '       OnThraedExit(EventArgs.Empty)
     37
    3738    End Sub
    3839
    … …  
    5556    End Sub
    5657
    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"
    5879
    5980Private
    6081    Static Sub OnMainFormClosed(sender As Object, e As Args)
     82        OnThreadExit(Args.Empty)
    6183        ExitThread()
    6284    End Sub
    63 
    64     main As Form
    6585End Class
    6686

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ApplicationEvent.sbp

    r551 r559  
    11Public
    2     Sub AddThreadExit(h As Handler)
     2    Static Sub AddThreadExit(h As Handler)
    33        If IsNothing(threadExit) Then
    44            threadExit = h
    … …  
    77        End If
    88    End Sub
    9     Sub RemoveThreadExit(h As Handler)
     9    Static Sub RemoveThreadExit(h As Handler)
    1010        If Not IsNothing(threadExit) Then
    1111            threadExit -= h
    … …  
    1313    End Sub
    1414Protected
    15     Sub OnThreadExit(e As Args)
     15    Static Sub OnThreadExit(e As Args)
    1616        If Not IsNothing(threadExit) Then
    1717            threadExit(This, e)
    … …  
    1919    End Sub
    2020Private
    21     threadExit As Handler
     21    Static threadExit As Handler
    2222

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

    r551 r559  
    9191        Imports System.Runtime.InteropServices
    9292
     93        If hwnd <> 0 Then
     94            Throw New System.InvalidOperationException("Window already created.")
     95        End If
     96
    9397        Dim gch = GCHandle.Alloc(This)
    9498        TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr)
    … …  
    101105                .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
    102106            If hwnd = 0 Then
     107                Debug
    103108                ActiveBasic.Windows.ThrowByWindowsError(GetLastError())
    104109            End If
    … …  
    251256
    252257    Sub OnCreateBase(sender As Object, e As MessageArgs)
    253 '       OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
     258        OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
    254259    End Sub
    255260
    … …  
    333338            ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
    334339
    335             If AssociateHWnd(gch, hwnd) = False Then
    336                 Goto *InstanceIsNotFound
    337             End If
     340            AssociateHWnd(gch, hwnd)
    338341        End If
    339342        If msg = WM_NCDESTROY Then
    … …  
    349352
    350353    *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))
    352357        WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
    353358    End Function
    … …  
    360365    これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなる。
    361366    */
    362     Static Function AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND) As Boolean
     367    Static Sub AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND)
    363368        Imports System.Runtime.InteropServices
    364369        Dim rThis = gch.Target As Control
    365370        If IsNothing(rThis) Then
    366             Exit Function
     371            Exit Sub
    367372        End If
    368373        rThis.hwnd = hwnd
    369374        rThis.Prop[PropertyInstance] = GCHandle.ToIntPtr(gch) As HANDLE
    370     End Function
     375    End Sub
    371376
    372377    /*!

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEvent.sbp

    r551 r559  
    328328Private
    329329    keyPress As KeyPressHandler
    330 /*
     330
    331331Public
    332332    Sub AddCreate(h As CreateHandler)
    … …  
    372372Private
    373373    destroy As Handler
    374 */
     374

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Form.ab

    r551 r559  
    4545End Namespace 'Widnows
    4646End 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.UI
    55 
    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 Sub
    62 
    63 Class MyForm
    64     Inherits Form
    65 Public
    66     Sub MyForm()
    67         AddPaintDC(AddressOf (Paint))
    68         AddMouseClick(AddressOf (Mouse))
    69         s = "aaa"
    70     End Sub
    71 
    72 '   Sub Paint(sender As Object, e As PaintDCArgs)
    73 '       TextOut(e.Handle, 10, 10, ToTCStr(s), s.Length)
    74 '   End Sub
    75 
    76     Sub Mouse(sender As Object, e As MouseArgs)
    77         Invalidate()
    78     End Sub
    79 
    80     Sub OnClick(sender As Object, e As Args)
    81         OutputDebugString(Ex"====OnClick====\r\n")
    82     End Sub
    83 
    84     s As String
    85 End Class
    86 
    87 Dim f = New MyForm
    88 f.Create()
    89 f.Text = "Hello"
    90 
    91 Dim b = New Button
    92 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 = Nothing
    99 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  
    1717End Function
    1818
    19 Sub OutputEventHandlerCode(out As TextWriter, eventName As String, argBase As String, comment As String)
     19Sub OutputEventHandlerCode(out As TextWriter, eventName As String, argBase As String, comment As String, isStatic As Boolean)
    2020    Dim eventMember = EventNameToMemberVariableName(eventName)
    2121    Dim handlerType = argBase & "Handler"
    2222    Dim argsType = argBase & "Args"
     23    Dim staticKeyword = Nothing As String
     24    If isStatic Then staticKeyword = "Static "
    2325    out.WriteLine("Public")
    2426'   out.WriteLine(Ex"\t/*!")
    2527'   out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを追加する")
    2628'   out.WriteLine(Ex"\t*/")
    27     out.WriteLine(Ex"\tSub Add" & eventName & "(h As " & handlerType & ")")
     29    out.WriteLine(Ex"\t" & staticKeyword & "Sub Add" & eventName & "(h As " & handlerType & ")")
    2830    out.WriteLine(Ex"\t\tIf IsNothing(" & eventMember & ") Then")
    2931    out.WriteLine(Ex"\t\t\t" & eventMember & " = h")
    … …  
    3537'   out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを削除する")
    3638'   out.WriteLine(Ex"\t*/")
    37     out.WriteLine(Ex"\tSub Remove" & eventName & "(h As " & handlerType & ")")
     39    out.WriteLine(Ex"\t" & staticKeyword & "Sub Remove" & eventName & "(h As " & handlerType & ")")
    3840    out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then")
    3941    out.WriteLine(Ex"\t\t\t" & eventMember & " -= h")
    … …  
    4446'   out.WriteLine(Ex"\t@brief " & comment)
    4547'   out.WriteLine(Ex"\t*/")
    46     out.WriteLine(Ex"\tSub On" & eventName & "(e As " & argsType & ")")
     48    out.WriteLine(Ex"\t" & staticKeyword & "Sub On" & eventName & "(e As " & argsType & ")")
    4749    out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then")
    4850    out.WriteLine(Ex"\t\t\t" & eventMember & "(This, e)")
    … …  
    5052    out.WriteLine(Ex"\tEnd Sub")
    5153    out.WriteLine("Private")
    52     out.WriteLine(Ex"\t" & eventMember & " As " & handlerType)
     54    out.WriteLine(Ex"\t" & staticKeyword & eventMember & " As " & handlerType)
    5355    out.WriteLine()
    5456End Sub
    … …  
    5759'   "ウィンドウの描画が必要なときに呼び出されます。")
    5860
    59 Sub MakeControlEvent(t As String)
     61Sub MakeControlEvent(t As String, isStatic = False As Boolean)
    6062    Dim event As String, handler As String, comment As String
    6163    Dim n As DWord, i As DWord
    … …  
    7072                Dim a = ActiveBasic.Strings.Detail.Split(s, 9) 'Tab
    7173                If a.Count >= 3 Then
    72                     OutputEventHandlerCode(out, a[0], a[1], a[2])
     74                    OutputEventHandlerCode(out, a[0], a[1], a[2], isStatic)
    7375                End If
    7476            Loop
    … …  
    7981MakeControlEvent("Control")
    8082MakeControlEvent("Form")
    81 MakeControlEvent("Application")
     83MakeControlEvent("Application", True)
    8284End

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Windows.ab

    r303 r559  
    4747End Namespace
    4848
     49
     50/*!
     51@brief  Windows/COMのエラーを伝える例外クラス
     52@date   2008/07/13
     53@auther Egtra
     54*/
     55Class WindowsException
     56    Inherits System.Exception
     57Public
     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
     99Private
     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
     109End Class
     110
     111/*!
     112@brief  GetLastErrorのエラー値を基に例外を投げる。
     113@date   2008/07/13
     114@param[in] dwErrorCode  Win32エラーコード
     115@throw WindowsException 常に投げられる。
     116@auther Egtra
     117*/
     118Sub ThrowByWindowsError(dwErrorCode As DWord)
     119    Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode))
     120End Sub
     121
     122/*!
     123@brief  HRESULT値を基に例外を投げる。
     124@date   2008/07/13
     125@param[in] hr   HRESULT値
     126@throw WindowsException FAILED(hr)が真の場合
     127@auther Egtra
     128hrが成功値 (FAILED(hr) = False) の場合、この関数は何も行わない。
     129*/
     130Sub ThrowByHResult(hr As HRESULT)
     131    If FAILED(hr) Then
     132        Throw New WindowsException(hr)
     133    End If
     134End Sub
     135
    49136End Namespace 'Widnows
    50137End Namespace 'ActiveBasic

  • trunk/ab5.0/ablib/src/Classes/System/DateTime.ab

    r409 r559  
    576576
    577577        Dim dateTimeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, NULL, 0)
    578         Dim dateTimeFormats = malloc(dateTimeFormatSize) As PTSTR
     578        Dim dateTimeFormats = GC_malloc_atomic(dateTimeFormatSize) As PTSTR
    579579        GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, dateTimeFormats, dateTimeFormatSize)
    580580

  • trunk/ab5.0/ablib/src/Classes/System/Exception.ab

    r435 r559  
    153153    End Function
    154154
     155    Const Function ErrorCode() As HRESULT
     156        ErrorCode = hr
     157    End Function
     158Protected
    155159    /*!
    156160    @brief  HRESULT値の設定

  • trunk/ab5.0/ablib/src/Classes/System/misc.ab

    r468 r559  
    2828Class EventArgs
    2929Public
    30     Static Empty = New EventArgs
     30    Static Empty = Nothing As EventArgs
    3131End Class
    3232
Note: See TracChangeset for help on using the changeset viewer.