ニコニコ大会議2008行ってきました、なんて書こうかと思っていたらCP5が出てきてそれどころではなくなりましたね。

ああ゛あ゛ー、CP5出荷のときもOLE2関連のヘッダを無効にしたままでした。すみません、今回のコードはCP5だと動きません。雰囲気を味わうということで勘弁してください。あるいはSVNを追っかけてください。


今回、自分が一番の改良点だと思っているのは、ようやくCOM互換のVTBLをコンパイラが作ってくれるようになったことです。以前のOLEドラッグアンドドロップのコード(IEからのD&Dの受け入れ方
– プログラミング質問板
の自分の最初に書いたもの)を書き直してみました。

’MainWnd.sbp抜粋
Sub MainWnd_Destroy()
    RevokeDragDrop(hMainWnd)
    OleUninitialize()
    DragDrop5_DestroyObjects()
    PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
    If OleInitialize(0) <> S_OK Then Debug

    dropTargetImpl = New DropTargetImpl(hMainWnd)
    dropTargetImpl.AddRef()
    Dim hr = RegisterDragDrop(hMainWnd, ObjPtr(dropTargetImpl))
    If FAILED(hr) Then Debug
    dropTargetImpl.Release()
End Sub

RegisterDragDropを呼ぶときにObjPtr関数を噛ますのは、将来的には不要になってほしいです。だから、今はおまじないということにしておきます(ObjPtr自体の解説はいつかどこかできちんとやりますが)。

2つのDimはともに型推論形式です。=の右側から変数の型が決定されます。Dim hr As HRESULTなどといちいち書く必要がなくなって、自分は手放せないです。

CP5と関係ない変更点として、RegisterDragDropをAddRefとReleaseで挟んだことがあります。これは、Effective COMでそうやって参照カウントを「安定な」状態にしてから、インスタンスを使うべきというような話を見た覚えがあるからです。このプログラムでは問題なさそうですが、念のため従いました。

'OleDragDropImpl.abp
Imports System.Runtime.InteropServices

TypeDef ULONG = DWord

Class DropTargetImpl
    Implements IDropTarget
Public
    Sub DropTargetImpl(hwndTarget As HWND)
        refCount = 0
        hwnd = hwndTarget
        handle = GCHandle.Alloc(This)
    End Sub

    Virtual Function QueryInterface(ByRef iid As IID, ByRef pv As Any) As HRESULT
        OutputDebugString(Ex"QueryInterface - ImplUnknown\r\n")
        If IsEqualIID(iid, IID_IUnknown) <> FALSE Then
            Set_LONG_PTR(VarPtr(pv), ObjPtr(This) As LONG_PTR)
        ElseIf    IsEqualIID(iid, IID_IDropTarget) <> FALSE Then
            Set_LONG_PTR(VarPtr(pv), ObjPtr(This) As LONG_PTR)
        Else
            Set_LONG_PTR(VarPtr(pv), 0 As LONG_PTR)
            QueryInterface = E_NOINTERFACE
            Exit Function
        End If
        QueryInterface = S_OK
        AddRef()
    End Function

    Virtual Function AddRef() As ULONG
        OutputDebugString(Ex"AddRef - ImplUnknown\r\n")
        refCount++
        AddRef = refCount
    End Function

    Virtual Function Release() As ULONG
        OutputDebugString(Ex"Release - ImplUnknown\r\n")
        refCount--
        Release = refCount
        If refCount = 0 Then
            handle.Free()
        End If
    End Function

    Virtual Function DragEnter(
        /* [unique][in] */ ByVal pDataObj As IDataObject,
        /* [in] */ ByVal grfKeyState As DWord,
        /* [in] */ ByVal x As Long, ByVal y As Long,
        /* [out][in] */ ByRef effect As DWord) As HRESULT
        OutputDebugString(Ex"DragEnter - ImplDropTarget\r\n")
        DragEnter = S_OK
    End Function

    Virtual Function DragOver(
        /* [in] */ ByVal grfKeyState As DWord,
        /* [in] */ ByVal x As Long, ByVal y As Long,
        /* [out][in] */ ByRef effect As DWord) As HRESULT
        OutputDebugString(Ex"DragOver - ImplDropTarget\r\n")
        DragOver = S_OK
    End Function

    Virtual Function DragLeave() As HRESULT
        OutputDebugString(Ex"DragLeave - ImplDropTarget\r\n")
        DragLeave = S_OK
    End Function

    Virtual Function Drop(
        /* [unique][in] */ ByVal pDataObj As IDataObject,
        /* [in] */ ByVal grfKeyState As DWord,
        /* [in] */ ByVal x As Long, ByVal y As Long,
        /* [out][in] */ ByRef effect As DWord) As HRESULT
        OutputDebugString(Ex"Drop - ImplDropTarget\r\n")
        MessageBox(hwnd, "ドロップされました", "", MB_OK)
        Drop = S_OK
    End Function
Private
    refCount As ULONG
    hwnd As HWND
    handle As GCHandle
End Class

GCHandleはGCされないための対策で、AllocしてからFreeするまでGCされなくなります。以前のコードのごたごたがすっかりなくなりました。多少ByVal/ByRefを変えていますが、このコードでは影響ありませんでした、実質何もやっていないも同然なので。

そして、Interface.sbpとThunk.abpは不要になりました。前者はライブラリに宣言を一通りぶち込んだためで、後者は冒頭に書いたようにコンパイラがやってくれるからです。我ながらいい時代になったと思います。


スポンサード リンク

この記事のカテゴリ

  • ⇒ 自分も動かないとね、とりあえずOLE D&D@CP5
  • ⇒ 自分も動かないとね、とりあえずOLE D&D@CP5