登録日時: 2005年7月19日(火) 07:02 記事: 183
お住まい: 宮城県
|
せっかくなので、
「ライブラリに手を加えることなく、
簡単にOLEドラッグ&ドロップ(IEからのドロップ)を扱う。」
のコンセプトでまとめてみます。
AB4限定。
必要な宣言など。
OleDragDropInterface.sbp [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: /* ---------------------------------------------------
OleDragDropInterface.sbp
提供:イグトランス様
インターフェイスやその他宣言類
----------------------------------------------------- */
TypeDef BOOL = Long
TypeDef HRESULT = Long
TypeDef ULONG = DWord
TypeDef IID = GUID
TypeDef CLSID = GUID
TypeDef CLIPFORMAT = Word
Dim IID_IUnknown = [0, 0, 0, [&hC0, 0, 0, 0, 0, 0, 0, &h46]] As IID
Dim IID_IDataObject = [&h0000010e, 0, 0, [&hC0, 0, 0, 0, 0, 0, 0, &h46]] As IID
Dim IID_IDropTarget = [&h00000122, 0, 0, [&hC0, 0, 0, 0, 0, 0, 0, &h46]] As IID
Declare Function OleInitialize Lib "Ole32" (reserved As VoidPtr) As HRESULT
Declare Sub OleUninitialize Lib "Ole32" ()
Declare Function IsEqualGUID Lib "Ole32" (ByRef guid1 As GUID, ByRef guid2 As GUID) As BOOL
Declare Function IsEqualCLSID Lib "Ole32" Alias "IsEqualGUID" (ByRef clsid1 As CLSID, ByRef clsid2 As CLSID) As BOOL
Declare Function IsEqualIID Lib "Ole32" Alias "IsEqualGUID" (ByRef iid1 As IID, ByRef iid2 As IID) As BOOL
Function egtraOleInitialize() HRESULT
OleInitialize(0)
End Function
Declare Function RegisterDragDrop Lib "Ole32" (
hwnd As HWND,
pDropTarget As *IDropTarget _
) As HRESULT
Declare Function RevokeDragDrop Lib "Ole32" (
hwnd As HWND _
) As HRESULT
Declare Sub ReleaseStgMedium Lib "OLE32" (ByRef rmedium As STGMEDIUM)
Type FORMATETC
cfFormat As CLIPFORMAT
ptd As *DVTARGETDEVICE
dwAspect As DWord
lindex As Long
tymed As DWord
End Type
Type STGMEDIUM
tymed As DWord
data As VoidPtr
' C/C++では次のような共用体
/* [switch_type(DWORD), switch_is((DWORD) tymed)]
union {
[case(TYMED_GDI)] HBITMAP hBitmap;
[case(TYMED_MFPICT)] HMETAFILEPICT hMetaFilePict;
[case(TYMED_ENHMF)] HENHMETAFILE hEnhMetaFile;
[case(TYMED_HGLOBAL)] HGLOBAL hGlobal;
[case(TYMED_FILE)] LPWSTR lpszFileName;
[case(TYMED_ISTREAM)] IStream *pstm;
[case(TYMED_ISTORAGE)] IStorage *pstg;
[default] ;
};
*/
/*[unique]*/ pUnkForRelease As *IUnknown
End Type
Type DVTARGETDEVICE
tdSize As DWord
tdDriverNameOffset As Word
tdDeviceNameOffset As Word
tdPortNameOffset As Word
tdExtDevmodeOffset As Word
tdData[ELM(1)] As Byte
End Type
Class IDataObject
Inherits IUnknown
Public
Virtual Function /* [local] */ GetData(
/* [unique][in] */ ByRef rformatetcIn As FORMATETC,
/* [out] */ ByRef rmedium As STGMEDIUM _
) As HRESULT
Virtual Function /* [local] */ GetDataHere(
/* [unique][in] */ ByRef rformatetcIn As FORMATETC,
/* [out] */ ByRef pmedium As STGMEDIUM _
) As HRESULT
Virtual Function QueryGetData(
/* [unique][in] */ ByRef pformatetc As FORMATETC _
) As HRESULT
Virtual Function GetCanonicalFormatEtc(
/* [unique][in] */ ByRef pformatetcIn As FORMATETC,
/* [out] */ ByRef pmedium As STGMEDIUM _
) As HRESULT
Virtual Function /* [local] */ SetData(
/* [unique][in] */ pformatetcIn As *FORMATETC,
/* [out] */ pmedium As *STGMEDIUM,
/* [in] */ fRelease As BOOL _
) As HRESULT
Virtual Function EnumFormatEtc(
/* [in] */ ByVal dwDirection As DWord,
/* [out] */ ByRef rpenumFormatEtc As *IEnumFORMATETC _
) As HRESULT
Virtual Function DAdvise(
/* [in] */ ByRef pformatetc As FORMATETC,
/* [in] */ ByVal advf As DWORD,
/* [unique][in] */ ByVal pAdvSink As *IAdviseSink,
/* [out] */ ByVal pdwConnection As *DWord _
) As HRESULT
Virtual Function DUnadvise(
/* [in] */ ByVal dwConnection As DWord _
) As HRESULT
Virtual Function EnumDAdvise(
/* [out] */ ByRef rpenumAdvise As *IEnumSTATDATA _
) As HRESULT
End Class
Class IDropTarget
Inherits IUnknown
Public
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
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
Virtual Function DragLeave() As HRESULT
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
End Class
Class IAdviseSink
Inherits IUnknown
End Class
Class IEnumSTATDATA
Inherits IUnknown
End Class
Class IEnumFORMATETC
Inherits IUnknown
End Class
Enum DROPEFFECT
DROPEFFECT_NONE = 0
DROPEFFECT_COPY = 1
DROPEFFECT_MOVE = 2
DROPEFFECT_LINK = 4
DROPEFFECT_SCROLL = &h80000000
End Enum
Enum /*[transmit_as(long)]*/ TYMED
TYMED_HGLOBAL = 1
TYMED_FILE = 2
TYMED_ISTREAM = 4
TYMED_ISTORAGE = 8
TYMED_GDI = 16
TYMED_MFPICT = 32
TYMED_ENHMF = 64
TYMED_NULL = 0
End Enum
Enum DVASPECT
DVASPECT_CONTENT = 1
DVASPECT_THUMBNAIL = 2
DVASPECT_ICON = 4
DVASPECT_DOCPRINT = 8
End Enum
動作を定義した本体。
OleDragDropImplEx.sbp [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: /* ---------------------------------------------------
OleDragDropImplEx.sbp
提供:イグトランス様
実際にOLEドラッグアンドドロップを受け取るためのクラス
※一部書き換えBy淡幻星
----------------------------------------------------- */
'追加定数と構造体(By淡幻星)
Const WM_OLEDROP_NOTIFY = WM_USER + 100
Const OLEDROP_MSG_DropLink = 1
Const OLEDROP_MSG_DropFile = 2
Type OleDragDropInfo
pDragDropBuffer As BytePtr
hHeap As Long
hWnd As Long
End Type
Class DropTargetImpl
Inherits DropTargetImplThunk
pDragDropPathBuf As BytePtr
Public
Sub DropTargetImpl(hwndTarget As HWND, lpOleDragDropInfo As *OleDragDropInfo)
refCount = 0
hwnd = hwndTarget
pDragDropPathBuf = lpOleDragDropInfo->pDragDropBuffer
End Sub
Function QueryInterface(ByRef iid As IID, ppvObj As *VoidPtr) As HRESULT
' OutputDebugString(Ex"QueryInterface - ImplUnknown\r\n")
QueryInterface = S_OK
If IsEqualIID(iid, IID_IUnknown) <> FALSE Then
ppvObj[0] = VarPtr (This) As *IUnknown
AddRef()
ElseIf IsEqualIID(iid, IID_IDropTarget) <> FALSE Then
ppvObj[0] = VarPtr (This) As *IDropTarget
AddRef()
Else
ppvObj[0] = 0
QueryInterface = E_NOINTERFACE
End If
End Function
Function AddRef() As ULONG
refCount++
AddRef = refCount
End Function
Function Release() As ULONG
refCount--
Release = refCount
If refCount = 0 Then
Delete VarPtr(This)
End If
End Function
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
DragEnter = S_OK
End Function
Function DragOver(
/* [in] */ ByVal grfKeyState As DWord,
/* [in] */ ByVal x As Long, ByVal y As Long,
/* [out][in] */ ByRef effect As DWord) As HRESULT
DragOver = S_OK
End Function
Function DragLeave() As HRESULT
DragLeave = S_OK
End Function
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
Dim fData As Long
fData = FALSE
Dim fe As FORMATETC
Dim medium As STGMEDIUM
Dim hglMem As HGLOBAL
'IEからのリンクドロップ
With fe
.cfFormat = CF_TEXT
.ptd = 0
.dwAspect = DVASPECT_CONTENT
.lindex = -1
.tymed = TYMED_HGLOBAL
End With
If( pDataObj->GetData(fe, medium) = S_OK )Then
hglMem = medium.data As HGLOBAL
lstrcpy( pDragDropPathBuf, GlobalLock(hglMem) )
GlobalUnlock(medium.data)
ReleaseStgMedium(medium)
SendMessage( hwnd, WM_OLEDROP_NOTIFY, OLEDROP_MSG_DropLink, pDragDropPathBuf )
effect = DROPEFFECT_COPY
fData = TRUE
End If
'ファイルドロップ
fe.cfFormat = CF_HDROP
If( pDataObj->GetData(fe, medium) = S_OK )Then
hglMem = medium.data As HGLOBAL
DragQueryFile( GlobalLock(hglMem), 0, pDragDropPathBuf, MAX_PATH )
GlobalUnlock(medium.data)
ReleaseStgMedium(medium)
SendMessage( hwnd, WM_OLEDROP_NOTIFY, OLEDROP_MSG_DropFile, pDragDropPathBuf )
effect = DROPEFFECT_COPY
fData = TRUE
End If
'それ以外
If( fData=FALSE )Then
effect = DROPEFFECT_NONE
End If
Drop = S_OK
End Function
Private
refCount As ULONG
hwnd As HWND
End Class
補完ファイル。
OleDragDropThunkEx.sbp [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: /* ---------------------------------------------------
OleDragDropThunkEx.sbp
提供:イグトランス様
「COMのインターフェイスのメソッドをABのクラスのメソッドへ委譲するコードがあります。
ABのクラスがCOMインターフェイスの実装に使えるようになったら
このファイルは丸ごと不要になる予定です。
単にCOMやOLEを使いたいだけならあまりじろじろ覗かないことをお勧めします。」
※一部書き換えBy淡幻星
----------------------------------------------------- */
Class IUnknownVTable
Public
QueryInterface As *Function(ByRef thunk As IUnknown, ByRef iid As IID, ppvObj As *VoidPtr) As HRESULT
AddRef As *Function(ByRef thunk As IUnknown) As ULONG
Release As *Function(ByRef thunk As IUnknown) As ULONG
End Class
Class IDropTargetVTable
Inherits IUnknownVTable
Public
DragEnter As *Function(
ByRef thunk As DropTargetImpl,
/* [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
DragOver As *Function(
ByRef thunk As DropTargetImpl,
/* [in] */ ByVal grfKeyState As DWord,
/* [in] */ ByVal x As Long, ByVal y As Long,
/* [out][in] */ ByRef effect As DWord) As HRESULT
DragLeave As *Function(ByRef thunk As DropTargetImpl) As HRESULT
Drop As *Function(
ByRef thunk As DropTargetImpl,
/* [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
End Class
Class DropTargetImplThunk
Public
vtable As *IDropTargetVTable
End Class
Function IUnknownThunk_QueryInterface(ByRef unk As DropTargetImpl, ByRef iid As IID, ppvObj As *VoidPtr) As HRESULT
IUnknownThunk_QueryInterface = unk.QueryInterface(iid, ppvObj)
End Function
Function IUnknownThunk_AddRef(ByRef unk As DropTargetImpl) As ULONG
IUnknownThunk_AddRef = unk.AddRef()
End Function
Function IUnknownThunk_Release(ByRef unk As DropTargetImpl) As ULONG
Dim vtable As *IDropTargetVTable
vtable = unk.vtable
IUnknownThunk_Release = unk.Release()
If IUnknownThunk_Release = 0 Then
Delete vtable
End If
End Function
Function IDropTargetThunk_DragEnter(
ByRef thunk As DropTargetImpl,
/* [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
IDropTargetThunk_DragEnter = thunk.DragEnter(pDataObj, grfKeyState, x, y, effect)
End Function
Function IDropTargetThunk_DragOver(
ByRef thunk As DropTargetImpl,
/* [in] */ ByVal grfKeyState As DWord,
/* [in] */ ByVal x As Long, ByVal y As Long,
/* [out][in] */ ByRef effect As DWord) As HRESULT
IDropTargetThunk_DragOver = thunk.DragOver(grfKeyState, x, y, effect)
End Function
Function IDropTargetThunk_DragLeave(ByRef thunk As DropTargetImpl) As HRESULT
IDropTargetThunk_DragLeave = thunk.DragLeave()
End Function
Function IDropTargetThunk_Drop(
ByRef thunk As DropTargetImpl,
/* [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
IDropTargetThunk_Drop = thunk.Drop(pDataObj, grfKeyState, x, y, effect)
End Function
'↓引数を追加@lpOleDragDropInfo(By淡幻星)
Function CreateDropTargetImpl(hwnd As HWND, lpOleDragDropInfo As *OleDragDropInfo, ByRef iid As IID, ByVal ppv As *VoidPtr) As HRESULT
CreateDropTargetImpl = E_OUTOFMEMORY
Dim punk As *DropTargetImpl
punk = New DropTargetImpl(hwnd, lpOleDragDropInfo)
If punk = 0 Then Exit Function
punk->vtable = New IDropTargetVTable
If punk->vtable = 0 Then Exit Function
With punk->vtable[0]
.QueryInterface = AddressOf (IUnknownThunk_QueryInterface)
.AddRef = AddressOf (IUnknownThunk_AddRef)
.Release = AddressOf (IUnknownThunk_Release)
.DragEnter = AddressOf (IDropTargetThunk_DragEnter)
.DragOver = AddressOf (IDropTargetThunk_DragOver)
.DragLeave = AddressOf (IDropTargetThunk_DragLeave)
.Drop = AddressOf (IDropTargetThunk_Drop)
End With
CreateDropTargetImpl = punk->QueryInterface(iid, ppv)
If CreateDropTargetImpl <> S_OK Then
CreateDropTargetImpl = 0
Delete punk
End If
End Function
ライブラリ内部を全く見ないで扱うためにまとめた関数。
OleDragDropFunc.sbp [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: /* ---------------------------------------------------
OleDragDropFunc.sbp
OLEドラッグアンドドロップを
DragAcceptFiles() + DragQueryFile() + DragFinish()
の形式と同様にして簡単に扱うための関数と定数。
----------------------------------------------------- */
'OLEドラッグ&ドロップを許可する。
Function OleDragDropWatcher_Create( hWnd As Long ) As Long
Dim hAny As Long
Dim pAny As VoidPtr
Dim lpOleDragDropInfo As *OleDragDropInfo
Dim pDropTarget As *IDropTarget
Dim hr As HRESULT
hAny = HeapCreate( NULL, 0, 0 )
pAny = HeapAlloc( hAny, HEAP_ZERO_MEMORY, SizeOf(OleDragDropInfo) )
lpOleDragDropInfo = pAny As *OleDragDropInfo
lpOleDragDropInfo->pDragDropBuffer = HeapAlloc( hAny, HEAP_ZERO_MEMORY, MAX_PATH ) As BytePtr
lpOleDragDropInfo->hHeap = hAny
lpOleDragDropInfo->hWnd = hWnd
If( egtraOleInitialize() <> S_OK )Then
OleDragDropWatcher_Create = NULL
ExitFunction
End If
hr = CreateDropTargetImpl( hWnd, lpOleDragDropInfo, IID_IDropTarget, VarPtr(pDropTarget) )
hr = RegisterDragDrop( hWnd, pDropTarget )
OleDragDropWatcher_Create = lpOleDragDropInfo As Long
End Function
'OLEドラッグ&ドロップを禁止する。
Sub OleDragDropWatcher_Destory( pHandle As Long )
Dim lpOleDragDropInfo As *OleDragDropInfo
Dim hAny As HANDLE
lpOleDragDropInfo = pHandle As *OleDragDropInfo
RevokeDragDrop( lpOleDragDropInfo->hWnd )
OleUninitialize()
hAny = lpOleDragDropInfo->hHeap
HeapDestroy( hAny )
End Sub
使い方。
D&Dを受け付ける窓のCreateイベントなどで、
Function OleDragDropWatcher_Create( hWnd As Long ) As Long
を実行。
返り値は後に使うので[Dim hDrop As HANDLE]などに保持。
受け入れなくするときは(通常はDestroyイベントで)
Sub OleDragDropWatcher_Destory( pHandle As Long )
を実行。引数は上記の返り値[hDrop]を指定。
ファイル、もしくはIEリンクがD&Dが行われると、
指定した窓プロシージャにWM_OLEDROP_NOTIFYが送られる。
wParam As WPARAMにはドロップされた種類が格納される。
リンクならば、[OLEDROP_MSG_DropLink]
ファイルならば、[OLEDROP_MSG_DropFile]
そのリンク(URL)と、ファイル(フルパス)がlParam As LPARAMに
BytePtr型で与えられる。
以上、通常のD&Dを意識してまとめて見ました。
内部は私自身も良く分かってないところが残ってますが、参考までに。
イグトランス様、本当にありがとうございましたm(_ _)m
|
|