Changeset 615

Timestamp:

2008/08/24 17:28:59 (4 years ago)

Author:

egtra

Message:

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

Location:

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

Files:

• UI/ApplicationEvent.sbp (modified) (1 diff)
• UI/Control.ab (modified) (20 diffs)
• UI/ControlEvent.sbp (modified) (19 diffs)
• UI/EventArgs.ab (modified) (5 diffs)
• UI/Form.ab (modified) (2 diffs)
• UI/FormEvent.sbp (modified) (1 diff)
• UI/MakeControlEventHandler.ab (modified) (2 diffs)
• UI/WindowHandle.sbp (modified) (1 diff)
• Windows.ab (modified) (1 diff)

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

@@ -13 +13 @@
     End Sub
 Protected
-    Static Sub OnThreadExit(e As Args)
+    Static Function OnThreadExit(e As Args) As Boolean
         If Not IsNothing(threadExit) Then
             threadExit(This, e)
+            Return True
         End If
-    End Sub
+    End Function
 Private
     Static threadExit As Handler

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

@@ -12 +12 @@
 End Namespace
 
+/*
+@brief Windowsのウィンドウを管理する基底クラス
+@auther Egtra
+*/
 Class Control
     Inherits WindowHandle
@@ -24 +28 @@
     Sub Control()
         comImpl = New COM.ComClassDelegationImpl(This)
-    End Sub
-
-    Virtual Sub ~Control()
     End Sub
 
@@ -52 +53 @@
 '--------------------------------
 ' ウィンドウ作成
-'   Function Create(
-'       parent As HWND,
-'       rect As RECT,
-'       name As String,
-'       style As DWord,
-'       exStyle = 0 As DWord,
-'       menu = 0 As HMENU) As HWND
 
 Public
@@ -108 +102 @@
         CreateEx(parent, style Or WS_CHILD Or WS_VISIBLE, exStyle, id As ULONG_PTR As HMENU)
     End Sub
+
 Protected
     Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
 
     Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control)
-        If hwnd <> 0 Then
-            Throw New System.InvalidOperationException("Window already created.")
-        End If
+        throwIfAlreadyCreated()
 
         StartWndProc()
@@ -123 +116 @@
                 .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
             If hwnd = 0 Then
-                ActiveBasic.Windows.ThrowWithLastError()
+                ThrowWithLastErrorNT("Control.CreateEx")
             End If
             
@@ -134 +127 @@
         If IsNothing(parent) = False Then
             RegisterUnassociateHWnd(parent)
+        End If
+    End Sub
+
+Public
+    Sub Attach(hwndNew As HWND)
+        throwIfAlreadyCreated()
+        If hwndNew = 0 Then
+            Throw New System.ArgumentNullException("Control.Attach")
+        End If
+        registerStandardEvent()
+        AssociateHWnd(hwndNew)
+        prevWndProc = SetWindowLongPtr(GWLP_WNDPROC, AddressOf(WndProcFirst) As LONG_PTR) As WNDPROC
+    End Sub
+
+Private
+    Sub throwIfAlreadyCreated()
+        If hwnd <> 0 Then
+            Throw New System.InvalidOperationException("Window already created.")
         End If
     End Sub
@@ -148 +159 @@
                 Dim a = New MessageArgs(hwnd, msg, wp, lp)
                 h(This, a)
-                WndProc = a.LResult
-                Exit Function
+                If a.Handled Then
+                    WndProc = a.LResult
+                    Exit Function
+                End If
             End If
         End If
@@ -156 +169 @@
 
     Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
-        DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
+        If prevWndProc Then
+            DefWndProc = CallWindowProc(prevWndProc, hwnd, msg, wp, lp)
+        Else
+            DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
+        End If
     End Function
 
@@ -219 +236 @@
 
     Sub OnEraseBackground(sender As Object, e As MessageArgs)
-        If IsNothing(paintBackground) Then
-            Dim rc = ClientRect
-            FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
-        Else
-            OnPaintBackground(New PaintBackgroundArgs(e.WParam, e.LParam))
-        End If
-        e.LResult = TRUE
+        Dim a = New PaintBackgroundArgs(e.WParam, e.LParam)
+        e.Handled = e.Handled And OnPaintBackground(a)
+        e.LResult = a.Painted
     End Sub
 
     Sub OnMouseDownBase(sender As Object, e As MessageArgs)
-        OnMouseDown(makeMouseEventFromMsg(e))
+        e.Handled = e.Handled And OnMouseDown(makeMouseEventFromMsg(e))
     End Sub
 
@@ -240 +253 @@
             doubleClickFired = False
         End If
-        OnMouseUp(me)
+        e.Handled = e.Handled And OnMouseUp(me)
     End Sub
 
@@ -248 +261 @@
         OnMouseDown(me)
         OnDoubleClick(Args.Empty)
-        OnMouseDoubleClick(me)
+        e.Handled = e.Handled And OnMouseDoubleClick(me)
     End Sub
 
@@ -258 +271 @@
             trackMouseEvent(TME_LEAVE Or TME_HOVER)
         End If
-        OnMouseMove(me)
+        e.Handled = e.Handled And OnMouseMove(me)
     End Sub
 
     Sub OnMouseLeaveBase(sender As Object, e As MessageArgs)
-        OnMouseLeave(Args.Empty)
+        e.Handled = e.Handled And OnMouseLeave(Args.Empty)
         mouseEntered = False
     End Sub
@@ -268 +281 @@
     Sub OnMouseHoverBase(sender As Object, e As MessageArgs)
         Dim me = makeMouseEventFromMsg(e)
-        OnMouseHover(me)
+        e.Handled = e.Handled And OnMouseHover(me)
     End Sub
 
     Sub OnPaintBase(sender As Object, e As MessageArgs)
-        Dim ps As PAINTSTRUCT
-        BeginPaint(ps)
-        Try
-            OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
-        Finally
-            EndPaint(ps)
-        End Try
+        If ActiveBasic.IsNothing(paintDC) Then
+            e.Handled = False
+        Else
+            Dim ps As PAINTSTRUCT
+            BeginPaint(ps)
+            Try
+                OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
+            Finally
+                EndPaint(ps)
+            End Try
+        End If
     End Sub
 
     Sub OnKeyDownBase(sender As Object, e As MessageArgs)
-        OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
+        e.Handled = e.Handled And OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
     End Sub
 
     Sub OnKeyUpBase(sender As Object, e As MessageArgs)
-        OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
+        e.Handled = e.Handled And OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
     End Sub
 
     Sub OnChar(sender As Object, e As MessageArgs)
-        OnKeyPress(New KeyPressArgs(e.WParam As Char))
+        e.Handled = e.Handled And OnKeyPress(New KeyPressArgs(e.WParam As Char))
     End Sub
 
     Sub OnCreateBase(sender As Object, e As MessageArgs)
-        OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
+        e.Handled = e.Handled And OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
     End Sub
 
     Sub OnSize(sender As Object, e As MessageArgs)
-        OnResize(New ResizeArgs(e.WParam, e.LParam))
+        e.Handled = e.Handled And OnResize(New ResizeArgs(e.WParam, e.LParam))
     End Sub
 
@@ -352 +369 @@
 Private
     /*!
+    @brief  サブクラス化前のウィンドウプロシージャ
+    @date   2008/08/23
+    サブクラス化していなければNULL
+    */
+    prevWndProc As WNDPROC
+    /*!
     @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ
     外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。
@@ -381 +404 @@
         If msg = WM_NCDESTROY Then
             rThis.UnassociateHWnd()
+            rThis.hwnd = 0
         End If
         If msg = WM_DESTROY And IsNothing(rThis.finalDestroy) = False Then
             Dim f = rThis.finalDestroy
             f(rThis, Args.Empty)
-'           finalDestroy(This, Args.Empty)
         End If
         WndProcFirst = rThis.WndProc(msg, wp, lp)
@@ -391 +414 @@
 
     *InstanceIsNotFound
-        Dim err = "ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found. msg = &h" _
-            + Hex$(msg) + Ex"\r\n"
+        Dim err = String.Concat("Control.WndProcFirst: The attached instance is not found. msg = &h",
+            Hex$(msg), Ex"\r\n")
         OutputDebugString(ToTCStr(err))
         WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
@@ -399 +422 @@
     /*!
     @brief  Controlインスタンスとウィンドウハンドルを結び付ける。
-    @param[in] hwnd 結び付けるウィンドウハンドル
+    @param[in] hwndNew  結び付けるウィンドウハンドル
     @date   2008/07/16
     これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなると共に、
     FromHWndでウィンドウハンドルからControlインスタンスの取得が可能となる。
     */
-    Sub AssociateHWnd(hwnd As HWND)
-        This.hwnd = hwnd
-        This.Prop[PropertyInstance] = ObjPtr(This) As HANDLE
+    Sub AssociateHWnd(hwndNew As HWND)
+        hwnd = hwndNew
+        Prop[PropertyInstance] = ObjPtr(This) As HANDLE
         comImpl.AddRef()
     End Sub
@@ -429 +452 @@
     Sub UnassociateHWndOnEvent(sender As Object, e As Args)
         UnassociateHWnd()
+        hwnd = 0
     End Sub
 
@@ -447 +471 @@
 
 Private
+    /*!
+    @brief ウィンドウの寿命管理
+    Controlには次のAddRef-Releaseの対がある。
+    @li createImpl - WM_NCDESTROY（ウィンドウプロシージャがWndProcFirstの場合）
+    @li createImpl - UnassociateHWnd←UnassociateHWndOnEvent←RegisterUnassociateHWnd（その他のウィンドウクラスの場合）
+    @li Attach - WM_NCDESTROY（サブクラス化された場合）
+    なお、Control派生クラスをサブクラス化すると、後ろ2つが両方適用される。
+    */
     comImpl As COM.ComClassDelegationImpl
+
 '--------------------------------
 '   その他の補助関数
@@ -526 +559 @@
         End If
     End Sub
-
 End Class
 

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

@@ -13 +13 @@
     End Sub
 Protected
-    Sub OnPaintDC(e As PaintDCArgs)
+    Function OnPaintDC(e As PaintDCArgs) As Boolean
         If Not IsNothing(paintDC) Then
             paintDC(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     paintDC As PaintDCHandler
@@ -35 +36 @@
     End Sub
 Protected
-    Sub OnClick(e As Args)
+    Function OnClick(e As Args) As Boolean
         If Not IsNothing(click) Then
             click(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     click As Handler
@@ -57 +59 @@
     End Sub
 Protected
-    Sub OnDoubleClick(e As Args)
+    Function OnDoubleClick(e As Args) As Boolean
         If Not IsNothing(doubleClick) Then
             doubleClick(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     doubleClick As Handler
@@ -79 +82 @@
     End Sub
 Protected
-    Sub OnMove(e As Args)
+    Function OnMove(e As Args) As Boolean
         If Not IsNothing(move) Then
             move(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     move As Handler
@@ -101 +105 @@
     End Sub
 Protected
-    Sub OnResize(e As ResizeArgs)
+    Function OnResize(e As ResizeArgs) As Boolean
         If Not IsNothing(resize) Then
             resize(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     resize As ResizeHandler
@@ -123 +128 @@
     End Sub
 Protected
-    Sub OnMouseEnter(e As MouseArgs)
+    Function OnMouseEnter(e As MouseArgs) As Boolean
         If Not IsNothing(mouseEnter) Then
             mouseEnter(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     mouseEnter As MouseHandler
@@ -145 +151 @@
     End Sub
 Protected
-    Sub OnMouseMove(e As MouseArgs)
+    Function OnMouseMove(e As MouseArgs) As Boolean
         If Not IsNothing(mouseMove) Then
             mouseMove(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     mouseMove As MouseHandler
@@ -167 +174 @@
     End Sub
 Protected
-    Sub OnMouseHover(e As MouseArgs)
+    Function OnMouseHover(e As MouseArgs) As Boolean
         If Not IsNothing(mouseHover) Then
             mouseHover(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     mouseHover As MouseHandler
@@ -189 +197 @@
     End Sub
 Protected
-    Sub OnMouseLeave(e As Args)
+    Function OnMouseLeave(e As Args) As Boolean
         If Not IsNothing(mouseLeave) Then
             mouseLeave(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     mouseLeave As Handler
@@ -211 +220 @@
     End Sub
 Protected
-    Sub OnMouseDown(e As MouseArgs)
+    Function OnMouseDown(e As MouseArgs) As Boolean
         If Not IsNothing(mouseDown) Then
             mouseDown(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     mouseDown As MouseHandler
@@ -233 +243 @@
     End Sub
 Protected
-    Sub OnMouseClick(e As MouseArgs)
+    Function OnMouseClick(e As MouseArgs) As Boolean
         If Not IsNothing(mouseClick) Then
             mouseClick(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     mouseClick As MouseHandler
@@ -255 +266 @@
     End Sub
 Protected
-    Sub OnMouseDoubleClick(e As MouseArgs)
+    Function OnMouseDoubleClick(e As MouseArgs) As Boolean
         If Not IsNothing(mouseDoubleClick) Then
             mouseDoubleClick(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     mouseDoubleClick As MouseHandler
@@ -277 +289 @@
     End Sub
 Protected
-    Sub OnMouseUp(e As MouseArgs)
+    Function OnMouseUp(e As MouseArgs) As Boolean
         If Not IsNothing(mouseUp) Then
             mouseUp(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     mouseUp As MouseHandler
@@ -299 +312 @@
     End Sub
 Protected
-    Sub OnKeyDown(e As KeyArgs)
+    Function OnKeyDown(e As KeyArgs) As Boolean
         If Not IsNothing(keyDown) Then
             keyDown(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     keyDown As KeyHandler
@@ -321 +335 @@
     End Sub
 Protected
-    Sub OnKeyUp(e As KeyArgs)
+    Function OnKeyUp(e As KeyArgs) As Boolean
         If Not IsNothing(keyUp) Then
             keyUp(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     keyUp As KeyHandler
@@ -343 +358 @@
     End Sub
 Protected
-    Sub OnKeyPress(e As KeyPressArgs)
+    Function OnKeyPress(e As KeyPressArgs) As Boolean
         If Not IsNothing(keyPress) Then
             keyPress(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     keyPress As KeyPressHandler
@@ -365 +381 @@
     End Sub
 Protected
-    Sub OnCreate(e As CreateArgs)
+    Function OnCreate(e As CreateArgs) As Boolean
         If Not IsNothing(create) Then
             create(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     create As CreateHandler
@@ -387 +404 @@
     End Sub
 Protected
-    Sub OnDestroy(e As Args)
+    Function OnDestroy(e As Args) As Boolean
         If Not IsNothing(destroy) Then
             destroy(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     destroy As Handler
@@ -409 +427 @@
     End Sub
 Protected
-    Sub OnPaintBackground(e As PaintBackgroundArgs)
+    Function OnPaintBackground(e As PaintBackgroundArgs) As Boolean
         If Not IsNothing(paintBackground) Then
             paintBackground(This, e)
-        End If
-    End Sub
+            Return True
+        End If
+    End Function
 Private
     paintBackground As PaintBackgroundHandler

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

@@ -21 +21 @@
         lp = lParam
         lr = 0
+        handled = True
     End Sub
 
@@ -45 +46 @@
     Sub LResult(lResult As LRESULT)
         lr = lResult
+    End Sub
+
+    Const Function Handled() As Boolean
+        Handled = handled
+    End Function
+
+    Sub Handled(h As Boolean)
+        handled = h
     End Sub
 Private
@@ -52 +61 @@
     lp As LPARAM
     lr As LRESULT
+    handled As Boolean
 End Class
 
@@ -550 +560 @@
     Sub PaintBackgroundArgs(hdc As HDC)
         This.hdc = hdc
+        This.painted = True
     End Sub
 
@@ -559 +570 @@
         Handle = hdc
     End Function
+
+    Const Function Painted() As Boolean
+        Painted = painted
+    End Function
+
+    Sub Painted(p As Boolean)
+        painted = p
+    End Sub
 Private
     hdc As HDC
+    painted As Boolean
 End Class
 

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

@@ -18 +18 @@
 Public
     Sub Form()
-        AddMessageEvent(WM_COMMAND, AddressOf (OnCommand))
+        AddMessageEvent(WM_COMMAND, AddressOf(OnCommand))
+        AddPaintBackground(AddressOf(OnPaintBackground))
     End Sub
 
@@ -30 +31 @@
             .cy = CW_USEDEFAULT
         End With
+    End Sub
+
+    Sub OnPaintBackground(sender As Object, e As PaintBackgroundArgs)
+        Dim rc = ClientRect
+        FillRect(e.Handle, rc, (COLOR_3DFACE + 1) As HBRUSH)
     End Sub
 

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

@@ -13 +13 @@
     End Sub
 Protected
-    Sub OnQueryClose(e As FormClosingArgs)
+    Function OnQueryClose(e As FormClosingArgs) As Boolean
         If Not IsNothing(queryClose) Then
             queryClose(This, e)
+            Return True
         End If
-    End Sub
+    End Function
 Private
     queryClose As FormClosingHandler

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

@@ -46 +46 @@
 '   out.WriteLine(Ex"\t@brief " & comment)
 '   out.WriteLine(Ex"\t*/")
-    out.WriteLine(Ex"\t" & staticKeyword & "Sub On" & eventName & "(e As " & argsType & ")")
+    out.WriteLine(Ex"\t" & staticKeyword & "Function On" & eventName & "(e As " & argsType & ") As Boolean")
     out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then")
     out.WriteLine(Ex"\t\t\t" & eventMember & "(This, e)")
+    out.WriteLine(Ex"\t\t\tReturn True")
     out.WriteLine(Ex"\t\tEnd If")
-    out.WriteLine(Ex"\tEnd Sub")
+    out.WriteLine(Ex"\tEnd Function")
     out.WriteLine("Private")
     out.WriteLine(Ex"\t" & staticKeyword & eventMember & " As " & handlerType)
@@ -72 +73 @@
                 Dim a = ActiveBasic.Strings.Detail.Split(s, 9) 'Tab
                 If a.Count >= 3 Then
-                    OutputEventHandlerCode(out, a[0], a[1], a[2], isStatic)
+                    OutputEventHandlerCode(out, a.Item[0], a.Item[1], a.Item[2], isStatic)
                 End If
             Loop

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

@@ -547 +547 @@
         _System_SetWindowLongPtr(hwnd, GWLP_ID, newId)
     End Sub
-
+#endif
     Function DlgItem(idDlgItem As Long) As WindowHandle
         Dim w As WindowHandle(GetDlgItem(hwnd, idDlgItem))
         Return w
     End Function
-#endif
+
     Const Function ExStyle() As DWord
         Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord

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

@@ -112 +112 @@
 @brief  Windowsのエラー値を基に例外を投げる
 @param[in] dwErrorCode  Win32エラーコード
+@param[in] msg  補足説明
 @throw WindowsException 常に投げられる。
 @date 2008/07/13
 @auther Egtra
 */
-Sub ThrowWithErrorCode(dwErrorCode As DWord)
-    Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode))
+Sub ThrowWithErrorCode(dwErrorCode As DWord, msg = Nothing As String)
+    Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode), msg)
 End Sub
-
 /*!
-@brief 内部でGetLastErrorを呼んで、その値を基に例外を投げる。
-@throw WindowsException 常に投げられる。
+@brief WindowsExceptionを投げるラッパ。直前に呼び出したAPI関数などが失敗したときに用いる。
+@param[in] msg 補足説明
+@throw WindowsException 常に投げられる。
+@date 2008/08/20
+@auther Egtra
+WindowsExceptionを構築する際、GetLastError()の値を渡す。
+この関数では、直前のAPI関数が成功したかどうかを調べられないことに注意。
+*/
+Sub ThrowWithLastError(msg = Nothing As String)
+    ThrowWithErrorCode(GetLastError(), msg)
+End Sub
+/*!
+@brief （主にuser32の全部、gdi32の一部が対象）WindowsExceptionを投げるラッパ。直前に呼び出したAPI関数などが失敗したときに用いる。
+@param[in] msg 補足説明
+@throw WindowsException 常に投げられる。
 @date 2008/08/26
 @auther Egtra
+user32やgdi32の一部など、9xではGetLastErrorでエラーメッセージが取得できないものがある。
+そのため、9xでは一律にmsgのみでWindowsExceptionを構築して投げるようにしている。
+
+ところで、CEではNT同様GetLastErrorが使用できるため、
+CEへの移植を仮定すると、関数名にNTと付けるのがそぐわないと感じる。代案募集中。
 */
-Sub ThrowWithLastError()
-    ThrowWithErrorCode(GetLastError())
+Sub ThrowWithLastErrorNT(msg As String)
+    If Not Version.Is9x() Then
+        ThrowWithErrorCode(GetLastError(), msg)
+    Else
+        Throw New WindowsException(msg)
+    End If
 End Sub
 /*!
 @brief  HRESULT値を基に例外を投げる。
-@date   2008/07/13
-@param[in] hr   HRESULT値
+@param[in] hr HRESULT値
+@param[in] msg 補足説明
 @throw WindowsException FAILED(hr)が真の場合
-@auther Egtra
+@date 2008/07/13
+@auther Egtra
 hrが成功値 (FAILED(hr) = False) の場合、この関数は何も行わない。
 */
-Sub ThrowIfFailed(hr As HRESULT)
+Sub ThrowIfFailed(hr As HRESULT, msg = Nothing As String)
     If FAILED(hr) Then
-        Throw New WindowsException(hr)
+        Throw New WindowsException(hr, msg)
     End If
 End Sub