Changeset 559 for trunk


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
Files:
2 added
12 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

  • trunk/ab5.0/ablib/src/api_gdi.sbp

    r497 r559  
    978978Const DEFAULT_PALETTE =     15
    979979Const SYSTEM_FIXED_FONT =   16
     980'#if WINVER >= &h0400
     981Const DEFAULT_GUI_FONT = 17
     982'#endif
     983
    980984Declare Function GetStockObject Lib "gdi32" (fnObject As Long) As HANDLE
    981985

  • trunk/ab5.0/ablib/src/api_window.sbp

    r536 r559  
    454454Declare Function CallWindowProc Lib "user32" Alias _FuncName_CallWindowProc (lpPrevWndFunc As WNDPROC, hWnd As HWND, Msg As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
    455455Declare Function ChangeClipboardChain Lib "user32" (hwndRemove As HWND, hwndNewNext As HWND) As BOOL
    456 Declare Function CharLower Lib "user32" Alias _FuncName_CharLower (psz As PTSTR) As DWord
     456Declare Function CharLower Lib "user32" Alias _FuncName_CharLower (psz As PTSTR) As PTSTR
    457457Declare Function CharNext Lib "user32" Alias _FuncName_CharNext (lpszCurrent As LPCTSTR) As LPTSTR
    458458Declare Function CharNextExA Lib "user32" (CodePage As Word, lpCurrentChar As LPCSTR, dwFlags As DWord) As LPSTR
    459459Declare Function CharPrev Lib "user32" Alias _FuncName_CharPrev (lpszStart As LPCTSTR, lpszCurrent As LPCTSTR) As LPTSTR
    460460Declare Function CharPrevExA Lib "user32" (CodePage As Word, lpStart As LPCSTR, lpCurrentChar As LPCSTR, dwFlags As DWord) As LPSTR
    461 Declare Function CharUpper Lib "user32" Alias _FuncName_CharUpper (psz As PTSTR) As DWord
     461Declare Function CharUpper Lib "user32" Alias _FuncName_CharUpper (psz As PTSTR) As PTSTR
    462462Declare Function CheckMenuItem Lib "user32" (hMenu As HMENU, uIDCheckItem As DWord, uCheck As DWord) As DWord
    463463Declare Function CheckMenuRadioItem Lib "user32" (hMenu As HMENU, idFirst As DWord, idLast As DWord, idCheck As DWord, uFlags As DWord) As BOOL
Note: See TracChangeset for help on using the changeset viewer.