Changeset 615 for trunk/ab5.0


Ignore:
Timestamp:
Aug 24, 2008, 5:28:59 PM (16 years ago)
Author:
イグトランス (egtra)
Message:

サブクラス化機構(Control.Attach)の整備

Location:
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows
Files:
9 edited

Legend:

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

    r559 r615  
    1313    End Sub
    1414Protected
    15     Static Sub OnThreadExit(e As Args)
     15    Static Function OnThreadExit(e As Args) As Boolean
    1616        If Not IsNothing(threadExit) Then
    1717            threadExit(This, e)
     18            Return True
    1819        End If
    19     End Sub
     20    End Function
    2021Private
    2122    Static threadExit As Handler
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab

    r604 r615  
    1212End Namespace
    1313
     14/*
     15@brief Windowsのウィンドウを管理する基底クラス
     16@auther Egtra
     17*/
    1418Class Control
    1519    Inherits WindowHandle
     
    2428    Sub Control()
    2529        comImpl = New COM.ComClassDelegationImpl(This)
    26     End Sub
    27 
    28     Virtual Sub ~Control()
    2930    End Sub
    3031
     
    5253'--------------------------------
    5354' ウィンドウ作成
    54 '   Function Create(
    55 '       parent As HWND,
    56 '       rect As RECT,
    57 '       name As String,
    58 '       style As DWord,
    59 '       exStyle = 0 As DWord,
    60 '       menu = 0 As HMENU) As HWND
    6155
    6256Public
     
    108102        CreateEx(parent, style Or WS_CHILD Or WS_VISIBLE, exStyle, id As ULONG_PTR As HMENU)
    109103    End Sub
     104
    110105Protected
    111106    Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
    112107
    113108    Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control)
    114         If hwnd <> 0 Then
    115             Throw New System.InvalidOperationException("Window already created.")
    116         End If
     109        throwIfAlreadyCreated()
    117110
    118111        StartWndProc()
     
    123116                .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
    124117            If hwnd = 0 Then
    125                 ActiveBasic.Windows.ThrowWithLastError()
     118                ThrowWithLastErrorNT("Control.CreateEx")
    126119            End If
    127120           
     
    134127        If IsNothing(parent) = False Then
    135128            RegisterUnassociateHWnd(parent)
     129        End If
     130    End Sub
     131
     132Public
     133    Sub Attach(hwndNew As HWND)
     134        throwIfAlreadyCreated()
     135        If hwndNew = 0 Then
     136            Throw New System.ArgumentNullException("Control.Attach")
     137        End If
     138        registerStandardEvent()
     139        AssociateHWnd(hwndNew)
     140        prevWndProc = SetWindowLongPtr(GWLP_WNDPROC, AddressOf(WndProcFirst) As LONG_PTR) As WNDPROC
     141    End Sub
     142
     143Private
     144    Sub throwIfAlreadyCreated()
     145        If hwnd <> 0 Then
     146            Throw New System.InvalidOperationException("Window already created.")
    136147        End If
    137148    End Sub
     
    148159                Dim a = New MessageArgs(hwnd, msg, wp, lp)
    149160                h(This, a)
    150                 WndProc = a.LResult
    151                 Exit Function
     161                If a.Handled Then
     162                    WndProc = a.LResult
     163                    Exit Function
     164                End If
    152165            End If
    153166        End If
     
    156169
    157170    Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    158         DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
     171        If prevWndProc Then
     172            DefWndProc = CallWindowProc(prevWndProc, hwnd, msg, wp, lp)
     173        Else
     174            DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
     175        End If
    159176    End Function
    160177
     
    219236
    220237    Sub OnEraseBackground(sender As Object, e As MessageArgs)
    221         If IsNothing(paintBackground) Then
    222             Dim rc = ClientRect
    223             FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
    224         Else
    225             OnPaintBackground(New PaintBackgroundArgs(e.WParam, e.LParam))
    226         End If
    227         e.LResult = TRUE
     238        Dim a = New PaintBackgroundArgs(e.WParam, e.LParam)
     239        e.Handled = e.Handled And OnPaintBackground(a)
     240        e.LResult = a.Painted
    228241    End Sub
    229242
    230243    Sub OnMouseDownBase(sender As Object, e As MessageArgs)
    231         OnMouseDown(makeMouseEventFromMsg(e))
     244        e.Handled = e.Handled And OnMouseDown(makeMouseEventFromMsg(e))
    232245    End Sub
    233246
     
    240253            doubleClickFired = False
    241254        End If
    242         OnMouseUp(me)
     255        e.Handled = e.Handled And OnMouseUp(me)
    243256    End Sub
    244257
     
    248261        OnMouseDown(me)
    249262        OnDoubleClick(Args.Empty)
    250         OnMouseDoubleClick(me)
     263        e.Handled = e.Handled And OnMouseDoubleClick(me)
    251264    End Sub
    252265
     
    258271            trackMouseEvent(TME_LEAVE Or TME_HOVER)
    259272        End If
    260         OnMouseMove(me)
     273        e.Handled = e.Handled And OnMouseMove(me)
    261274    End Sub
    262275
    263276    Sub OnMouseLeaveBase(sender As Object, e As MessageArgs)
    264         OnMouseLeave(Args.Empty)
     277        e.Handled = e.Handled And OnMouseLeave(Args.Empty)
    265278        mouseEntered = False
    266279    End Sub
     
    268281    Sub OnMouseHoverBase(sender As Object, e As MessageArgs)
    269282        Dim me = makeMouseEventFromMsg(e)
    270         OnMouseHover(me)
     283        e.Handled = e.Handled And OnMouseHover(me)
    271284    End Sub
    272285
    273286    Sub OnPaintBase(sender As Object, e As MessageArgs)
    274         Dim ps As PAINTSTRUCT
    275         BeginPaint(ps)
    276         Try
    277             OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
    278         Finally
    279             EndPaint(ps)
    280         End Try
     287        If ActiveBasic.IsNothing(paintDC) Then
     288            e.Handled = False
     289        Else
     290            Dim ps As PAINTSTRUCT
     291            BeginPaint(ps)
     292            Try
     293                OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
     294            Finally
     295                EndPaint(ps)
     296            End Try
     297        End If
    281298    End Sub
    282299
    283300    Sub OnKeyDownBase(sender As Object, e As MessageArgs)
    284         OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
     301        e.Handled = e.Handled And OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
    285302    End Sub
    286303
    287304    Sub OnKeyUpBase(sender As Object, e As MessageArgs)
    288         OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
     305        e.Handled = e.Handled And OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
    289306    End Sub
    290307
    291308    Sub OnChar(sender As Object, e As MessageArgs)
    292         OnKeyPress(New KeyPressArgs(e.WParam As Char))
     309        e.Handled = e.Handled And OnKeyPress(New KeyPressArgs(e.WParam As Char))
    293310    End Sub
    294311
    295312    Sub OnCreateBase(sender As Object, e As MessageArgs)
    296         OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
     313        e.Handled = e.Handled And OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
    297314    End Sub
    298315
    299316    Sub OnSize(sender As Object, e As MessageArgs)
    300         OnResize(New ResizeArgs(e.WParam, e.LParam))
     317        e.Handled = e.Handled And OnResize(New ResizeArgs(e.WParam, e.LParam))
    301318    End Sub
    302319
     
    352369Private
    353370    /*!
     371    @brief  サブクラス化前のウィンドウプロシージャ
     372    @date   2008/08/23
     373    サブクラス化していなければNULL
     374    */
     375    prevWndProc As WNDPROC
     376    /*!
    354377    @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ
    355378    外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。
     
    381404        If msg = WM_NCDESTROY Then
    382405            rThis.UnassociateHWnd()
     406            rThis.hwnd = 0
    383407        End If
    384408        If msg = WM_DESTROY And IsNothing(rThis.finalDestroy) = False Then
    385409            Dim f = rThis.finalDestroy
    386410            f(rThis, Args.Empty)
    387 '           finalDestroy(This, Args.Empty)
    388411        End If
    389412        WndProcFirst = rThis.WndProc(msg, wp, lp)
     
    391414
    392415    *InstanceIsNotFound
    393         Dim err = "ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found. msg = &h" _
    394             + Hex$(msg) + Ex"\r\n"
     416        Dim err = String.Concat("Control.WndProcFirst: The attached instance is not found. msg = &h",
     417            Hex$(msg), Ex"\r\n")
    395418        OutputDebugString(ToTCStr(err))
    396419        WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
     
    399422    /*!
    400423    @brief  Controlインスタンスとウィンドウハンドルを結び付ける。
    401     @param[in] hwnd 結び付けるウィンドウハンドル
     424    @param[in] hwndNew  結び付けるウィンドウハンドル
    402425    @date   2008/07/16
    403426    これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなると共に、
    404427    FromHWndでウィンドウハンドルからControlインスタンスの取得が可能となる。
    405428    */
    406     Sub AssociateHWnd(hwnd As HWND)
    407         This.hwnd = hwnd
    408         This.Prop[PropertyInstance] = ObjPtr(This) As HANDLE
     429    Sub AssociateHWnd(hwndNew As HWND)
     430        hwnd = hwndNew
     431        Prop[PropertyInstance] = ObjPtr(This) As HANDLE
    409432        comImpl.AddRef()
    410433    End Sub
     
    429452    Sub UnassociateHWndOnEvent(sender As Object, e As Args)
    430453        UnassociateHWnd()
     454        hwnd = 0
    431455    End Sub
    432456
     
    447471
    448472Private
     473    /*!
     474    @brief ウィンドウの寿命管理
     475    Controlには次のAddRef-Releaseの対がある。
     476    @li createImpl - WM_NCDESTROY(ウィンドウプロシージャがWndProcFirstの場合)
     477    @li createImpl - UnassociateHWnd←UnassociateHWndOnEvent←RegisterUnassociateHWnd(その他のウィンドウクラスの場合)
     478    @li Attach - WM_NCDESTROY(サブクラス化された場合)
     479    なお、Control派生クラスをサブクラス化すると、後ろ2つが両方適用される。
     480    */
    449481    comImpl As COM.ComClassDelegationImpl
     482
    450483'--------------------------------
    451484'   その他の補助関数
     
    526559        End If
    527560    End Sub
    528 
    529561End Class
    530562
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ControlEvent.sbp

    r564 r615  
    1313    End Sub
    1414Protected
    15     Sub OnPaintDC(e As PaintDCArgs)
     15    Function OnPaintDC(e As PaintDCArgs) As Boolean
    1616        If Not IsNothing(paintDC) Then
    1717            paintDC(This, e)
    18         End If
    19     End Sub
     18            Return True
     19        End If
     20    End Function
    2021Private
    2122    paintDC As PaintDCHandler
     
    3536    End Sub
    3637Protected
    37     Sub OnClick(e As Args)
     38    Function OnClick(e As Args) As Boolean
    3839        If Not IsNothing(click) Then
    3940            click(This, e)
    40         End If
    41     End Sub
     41            Return True
     42        End If
     43    End Function
    4244Private
    4345    click As Handler
     
    5759    End Sub
    5860Protected
    59     Sub OnDoubleClick(e As Args)
     61    Function OnDoubleClick(e As Args) As Boolean
    6062        If Not IsNothing(doubleClick) Then
    6163            doubleClick(This, e)
    62         End If
    63     End Sub
     64            Return True
     65        End If
     66    End Function
    6467Private
    6568    doubleClick As Handler
     
    7982    End Sub
    8083Protected
    81     Sub OnMove(e As Args)
     84    Function OnMove(e As Args) As Boolean
    8285        If Not IsNothing(move) Then
    8386            move(This, e)
    84         End If
    85     End Sub
     87            Return True
     88        End If
     89    End Function
    8690Private
    8791    move As Handler
     
    101105    End Sub
    102106Protected
    103     Sub OnResize(e As ResizeArgs)
     107    Function OnResize(e As ResizeArgs) As Boolean
    104108        If Not IsNothing(resize) Then
    105109            resize(This, e)
    106         End If
    107     End Sub
     110            Return True
     111        End If
     112    End Function
    108113Private
    109114    resize As ResizeHandler
     
    123128    End Sub
    124129Protected
    125     Sub OnMouseEnter(e As MouseArgs)
     130    Function OnMouseEnter(e As MouseArgs) As Boolean
    126131        If Not IsNothing(mouseEnter) Then
    127132            mouseEnter(This, e)
    128         End If
    129     End Sub
     133            Return True
     134        End If
     135    End Function
    130136Private
    131137    mouseEnter As MouseHandler
     
    145151    End Sub
    146152Protected
    147     Sub OnMouseMove(e As MouseArgs)
     153    Function OnMouseMove(e As MouseArgs) As Boolean
    148154        If Not IsNothing(mouseMove) Then
    149155            mouseMove(This, e)
    150         End If
    151     End Sub
     156            Return True
     157        End If
     158    End Function
    152159Private
    153160    mouseMove As MouseHandler
     
    167174    End Sub
    168175Protected
    169     Sub OnMouseHover(e As MouseArgs)
     176    Function OnMouseHover(e As MouseArgs) As Boolean
    170177        If Not IsNothing(mouseHover) Then
    171178            mouseHover(This, e)
    172         End If
    173     End Sub
     179            Return True
     180        End If
     181    End Function
    174182Private
    175183    mouseHover As MouseHandler
     
    189197    End Sub
    190198Protected
    191     Sub OnMouseLeave(e As Args)
     199    Function OnMouseLeave(e As Args) As Boolean
    192200        If Not IsNothing(mouseLeave) Then
    193201            mouseLeave(This, e)
    194         End If
    195     End Sub
     202            Return True
     203        End If
     204    End Function
    196205Private
    197206    mouseLeave As Handler
     
    211220    End Sub
    212221Protected
    213     Sub OnMouseDown(e As MouseArgs)
     222    Function OnMouseDown(e As MouseArgs) As Boolean
    214223        If Not IsNothing(mouseDown) Then
    215224            mouseDown(This, e)
    216         End If
    217     End Sub
     225            Return True
     226        End If
     227    End Function
    218228Private
    219229    mouseDown As MouseHandler
     
    233243    End Sub
    234244Protected
    235     Sub OnMouseClick(e As MouseArgs)
     245    Function OnMouseClick(e As MouseArgs) As Boolean
    236246        If Not IsNothing(mouseClick) Then
    237247            mouseClick(This, e)
    238         End If
    239     End Sub
     248            Return True
     249        End If
     250    End Function
    240251Private
    241252    mouseClick As MouseHandler
     
    255266    End Sub
    256267Protected
    257     Sub OnMouseDoubleClick(e As MouseArgs)
     268    Function OnMouseDoubleClick(e As MouseArgs) As Boolean
    258269        If Not IsNothing(mouseDoubleClick) Then
    259270            mouseDoubleClick(This, e)
    260         End If
    261     End Sub
     271            Return True
     272        End If
     273    End Function
    262274Private
    263275    mouseDoubleClick As MouseHandler
     
    277289    End Sub
    278290Protected
    279     Sub OnMouseUp(e As MouseArgs)
     291    Function OnMouseUp(e As MouseArgs) As Boolean
    280292        If Not IsNothing(mouseUp) Then
    281293            mouseUp(This, e)
    282         End If
    283     End Sub
     294            Return True
     295        End If
     296    End Function
    284297Private
    285298    mouseUp As MouseHandler
     
    299312    End Sub
    300313Protected
    301     Sub OnKeyDown(e As KeyArgs)
     314    Function OnKeyDown(e As KeyArgs) As Boolean
    302315        If Not IsNothing(keyDown) Then
    303316            keyDown(This, e)
    304         End If
    305     End Sub
     317            Return True
     318        End If
     319    End Function
    306320Private
    307321    keyDown As KeyHandler
     
    321335    End Sub
    322336Protected
    323     Sub OnKeyUp(e As KeyArgs)
     337    Function OnKeyUp(e As KeyArgs) As Boolean
    324338        If Not IsNothing(keyUp) Then
    325339            keyUp(This, e)
    326         End If
    327     End Sub
     340            Return True
     341        End If
     342    End Function
    328343Private
    329344    keyUp As KeyHandler
     
    343358    End Sub
    344359Protected
    345     Sub OnKeyPress(e As KeyPressArgs)
     360    Function OnKeyPress(e As KeyPressArgs) As Boolean
    346361        If Not IsNothing(keyPress) Then
    347362            keyPress(This, e)
    348         End If
    349     End Sub
     363            Return True
     364        End If
     365    End Function
    350366Private
    351367    keyPress As KeyPressHandler
     
    365381    End Sub
    366382Protected
    367     Sub OnCreate(e As CreateArgs)
     383    Function OnCreate(e As CreateArgs) As Boolean
    368384        If Not IsNothing(create) Then
    369385            create(This, e)
    370         End If
    371     End Sub
     386            Return True
     387        End If
     388    End Function
    372389Private
    373390    create As CreateHandler
     
    387404    End Sub
    388405Protected
    389     Sub OnDestroy(e As Args)
     406    Function OnDestroy(e As Args) As Boolean
    390407        If Not IsNothing(destroy) Then
    391408            destroy(This, e)
    392         End If
    393     End Sub
     409            Return True
     410        End If
     411    End Function
    394412Private
    395413    destroy As Handler
     
    409427    End Sub
    410428Protected
    411     Sub OnPaintBackground(e As PaintBackgroundArgs)
     429    Function OnPaintBackground(e As PaintBackgroundArgs) As Boolean
    412430        If Not IsNothing(paintBackground) Then
    413431            paintBackground(This, e)
    414         End If
    415     End Sub
     432            Return True
     433        End If
     434    End Function
    416435Private
    417436    paintBackground As PaintBackgroundHandler
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab

    r575 r615  
    2121        lp = lParam
    2222        lr = 0
     23        handled = True
    2324    End Sub
    2425
     
    4546    Sub LResult(lResult As LRESULT)
    4647        lr = lResult
     48    End Sub
     49
     50    Const Function Handled() As Boolean
     51        Handled = handled
     52    End Function
     53
     54    Sub Handled(h As Boolean)
     55        handled = h
    4756    End Sub
    4857Private
     
    5261    lp As LPARAM
    5362    lr As LRESULT
     63    handled As Boolean
    5464End Class
    5565
     
    550560    Sub PaintBackgroundArgs(hdc As HDC)
    551561        This.hdc = hdc
     562        This.painted = True
    552563    End Sub
    553564
     
    559570        Handle = hdc
    560571    End Function
     572
     573    Const Function Painted() As Boolean
     574        Painted = painted
     575    End Function
     576
     577    Sub Painted(p As Boolean)
     578        painted = p
     579    End Sub
    561580Private
    562581    hdc As HDC
     582    painted As Boolean
    563583End Class
    564584
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Form.ab

    r561 r615  
    1818Public
    1919    Sub Form()
    20         AddMessageEvent(WM_COMMAND, AddressOf (OnCommand))
     20        AddMessageEvent(WM_COMMAND, AddressOf(OnCommand))
     21        AddPaintBackground(AddressOf(OnPaintBackground))
    2122    End Sub
    2223
     
    3031            .cy = CW_USEDEFAULT
    3132        End With
     33    End Sub
     34
     35    Sub OnPaintBackground(sender As Object, e As PaintBackgroundArgs)
     36        Dim rc = ClientRect
     37        FillRect(e.Handle, rc, (COLOR_3DFACE + 1) As HBRUSH)
    3238    End Sub
    3339
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/FormEvent.sbp

    r551 r615  
    1313    End Sub
    1414Protected
    15     Sub OnQueryClose(e As FormClosingArgs)
     15    Function OnQueryClose(e As FormClosingArgs) As Boolean
    1616        If Not IsNothing(queryClose) Then
    1717            queryClose(This, e)
     18            Return True
    1819        End If
    19     End Sub
     20    End Function
    2021Private
    2122    queryClose As FormClosingHandler
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/MakeControlEventHandler.ab

    r559 r615  
    4646'   out.WriteLine(Ex"\t@brief " & comment)
    4747'   out.WriteLine(Ex"\t*/")
    48     out.WriteLine(Ex"\t" & staticKeyword & "Sub On" & eventName & "(e As " & argsType & ")")
     48    out.WriteLine(Ex"\t" & staticKeyword & "Function On" & eventName & "(e As " & argsType & ") As Boolean")
    4949    out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then")
    5050    out.WriteLine(Ex"\t\t\t" & eventMember & "(This, e)")
     51    out.WriteLine(Ex"\t\t\tReturn True")
    5152    out.WriteLine(Ex"\t\tEnd If")
    52     out.WriteLine(Ex"\tEnd Sub")
     53    out.WriteLine(Ex"\tEnd Function")
    5354    out.WriteLine("Private")
    5455    out.WriteLine(Ex"\t" & staticKeyword & eventMember & " As " & handlerType)
     
    7273                Dim a = ActiveBasic.Strings.Detail.Split(s, 9) 'Tab
    7374                If a.Count >= 3 Then
    74                     OutputEventHandlerCode(out, a[0], a[1], a[2], isStatic)
     75                    OutputEventHandlerCode(out, a.Item[0], a.Item[1], a.Item[2], isStatic)
    7576                End If
    7677            Loop
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/WindowHandle.sbp

    r547 r615  
    547547        _System_SetWindowLongPtr(hwnd, GWLP_ID, newId)
    548548    End Sub
    549 
     549#endif
    550550    Function DlgItem(idDlgItem As Long) As WindowHandle
    551551        Dim w As WindowHandle(GetDlgItem(hwnd, idDlgItem))
    552552        Return w
    553553    End Function
    554 #endif
     554
    555555    Const Function ExStyle() As DWord
    556556        Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord
  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Windows.ab

    r603 r615  
    112112@brief  Windowsのエラー値を基に例外を投げる
    113113@param[in] dwErrorCode  Win32エラーコード
     114@param[in] msg  補足説明
    114115@throw WindowsException 常に投げられる。
    115116@date 2008/07/13
    116117@auther Egtra
    117118*/
    118 Sub ThrowWithErrorCode(dwErrorCode As DWord)
    119     Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode))
     119Sub ThrowWithErrorCode(dwErrorCode As DWord, msg = Nothing As String)
     120    Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode), msg)
    120121End Sub
    121 
    122122/*!
    123 @brief 内部でGetLastErrorを呼んで、その値を基に例外を投げる。
    124 @throw WindowsException 常に投げられる。
     123@brief WindowsExceptionを投げるラッパ。直前に呼び出したAPI関数などが失敗したときに用いる。
     124@param[in] msg 補足説明
     125@throw WindowsException 常に投げられる。
     126@date 2008/08/20
     127@auther Egtra
     128WindowsExceptionを構築する際、GetLastError()の値を渡す。
     129この関数では、直前のAPI関数が成功したかどうかを調べられないことに注意。
     130*/
     131Sub ThrowWithLastError(msg = Nothing As String)
     132    ThrowWithErrorCode(GetLastError(), msg)
     133End Sub
     134/*!
     135@brief (主にuser32の全部、gdi32の一部が対象)WindowsExceptionを投げるラッパ。直前に呼び出したAPI関数などが失敗したときに用いる。
     136@param[in] msg 補足説明
     137@throw WindowsException 常に投げられる。
    125138@date 2008/08/26
    126139@auther Egtra
     140user32やgdi32の一部など、9xではGetLastErrorでエラーメッセージが取得できないものがある。
     141そのため、9xでは一律にmsgのみでWindowsExceptionを構築して投げるようにしている。
     142
     143ところで、CEではNT同様GetLastErrorが使用できるため、
     144CEへの移植を仮定すると、関数名にNTと付けるのがそぐわないと感じる。代案募集中。
    127145*/
    128 Sub ThrowWithLastError()
    129     ThrowWithErrorCode(GetLastError())
     146Sub ThrowWithLastErrorNT(msg As String)
     147    If Not Version.Is9x() Then
     148        ThrowWithErrorCode(GetLastError(), msg)
     149    Else
     150        Throw New WindowsException(msg)
     151    End If
    130152End Sub
    131153/*!
    132154@brief  HRESULT値を基に例外を投げる。
    133 @date   2008/07/13
    134 @param[in] hr   HRESULT値
     155@param[in] hr HRESULT値
     156@param[in] msg 補足説明
    135157@throw WindowsException FAILED(hr)が真の場合
    136 @auther Egtra
     158@date 2008/07/13
     159@auther Egtra
    137160hrが成功値 (FAILED(hr) = False) の場合、この関数は何も行わない。
    138161*/
    139 Sub ThrowIfFailed(hr As HRESULT)
     162Sub ThrowIfFailed(hr As HRESULT, msg = Nothing As String)
    140163    If FAILED(hr) Then
    141         Throw New WindowsException(hr)
     164        Throw New WindowsException(hr, msg)
    142165    End If
    143166End Sub
Note: See TracChangeset for help on using the changeset viewer.