ab.com コミュニティ

コード: 全て選択

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

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 pmedium 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

コード: 全て選択

Class DropTargetImpl
	Inherits DropTargetImplThunk
Public
	Sub DropTargetImpl(hwndTarget As HWND)
		refCount = 0
		hwnd = hwndTarget
	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
		OutputDebugString(Ex"AddRef - ImplUnknown\r\n")
		refCount++
		AddRef = refCount
	End Function

	Function Release() As ULONG
		OutputDebugString(Ex"Release - ImplUnknown\r\n")
		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
		OutputDebugString(Ex"DragEnter - ImplDropTarget\r\n")
		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
		OutputDebugString(Ex"DragOver - ImplDropTarget\r\n")
		DragOver = S_OK
	End Function

	Function DragLeave() As HRESULT
		OutputDebugString(Ex"DragLeave - ImplDropTarget\r\n")
		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
		OutputDebugString(Ex"Drop - ImplDropTarget\r\n")
		MessageBox(hwnd, "ドロップされました", "", MB_OK)
		Drop = S_OK
	End Function
Private
	refCount As ULONG
	hwnd As HWND
End Class

コード: 全て選択

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

Function CreateDropTargetImpl(hwnd As HWND, ByRef iid As IID, ByVal ppv As *VoidPtr) As HRESULT
	CreateDropTargetImpl = E_OUTOFMEMORY
	Dim punk As *DropTargetImpl
	punk = New DropTargetImpl(hwnd)
	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

コード: 全て選択

Sub MainWnd_Destroy()
	RevokeDragDrop(hMainWnd)
	OleUninitialize()

	OleDragDrop_DestroyObjects() ' プロジェクト名に合わせてください。
	PostQuitMessage(0)
End Sub

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

	Dim pDropTarget As *IDropTarget
	Dim hr As HRESULT
	hr = CreateDropTargetImpl(hMainWnd, IID_IDropTarget, VarPtr(pDropTarget))
	hr = RegisterDragDrop(hMainWnd, pDropTarget)
End Sub

コード: 全て選択

    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)

		Dim rformatetcIn As FORMATETC
		Dim pmedium As STGMEDIUM
		Dim strBuf As String
		Dim pAny As VoidPtr

		rformatetcIn.cfFormat = CF_HDROP
		rformatetcIn.ptd = NULL
		rformatetcIn.dwAspect = DVASPECT_CONTENT
		rformatetcIn.lindex = -1
		rformatetcIn.tymed = TYMED_HGLOBAL

		pAny = pDataObj->vtable
		If( S_OK=pDataObj->GetData(rformatetcIn, pmedium) )Then
/*			strBuf = ZeroString( MAX_PATH+1 )
			DragQueryFile( pmedium.data As HDROP, 0 , StrPtr(strBuf), MAX_PATH )
			ReleaseStgMedium( pmedium )
			effect = DROPEFFECT_COPY
*/
		End If
Debug 'strBufに格納されたかをチェック。

        Drop = S_OK
    End Function

コード: 全て選択

Declare Sub ReleaseStgMedium Lib "Ole32" ( ByRef pmedium As STGMEDIUM )

Const DVASPECT_CONTENT	 = 1
Const DVASPECT_THUMBNAIL = 2
Const DVASPECT_ICON		 = 4
Const DVASPECT_DOCPRINT	 = 8

Const TYMED_HGLOBAL	 = 1
Const TYMED_FILE	 = 2
Const TYMED_ISTREAM	 = 4
Const TYMED_ISTORAGE = 8
Const TYMED_GDI		 = 16
Const TYMED_MFPICT	 = 32
Const TYMED_ENHMF	 = 64
Const TYMED_NULL	 = 0

Const MK_ALT = &H20

Const DROPEFFECT_NONE	 = 0
Const DROPEFFECT_COPY	 = 1
Const DROPEFFECT_MOVE	 = 2
Const DROPEFFECT_LINK	 = 4
Const DROPEFFECT_SCROLL	 = &H80000000

コード: 全て選択

'以下、移植です。By淡幻星

/*
//-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
//
//   OLEドラッグ&ドロップをCのみで行うDLL
//
//                             Copyright (C) Copyright 1998,2002 PATA
//                        Original source by nakka(Tomoaki Nakashima)
//-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*/

#ifndef _INC_OLEDRAGDROP
#define _INC_OLEDRAGDROP

/*
#ifndef DLLEXPORT
#define DLLEXPORT __declspec(dllexport)
#endif
*/

Const IDROPTARGET_NOTIFY_DRAGENTER = 0
Const IDROPTARGET_NOTIFY_DRAGOVER = 1
Const IDROPTARGET_NOTIFY_DRAGLEAVE = 2
Const IDROPTARGET_NOTIFY_DROP = 3


' dwEffect '-------------------------------
#ifndef	DROPEFFECT_NONE
Const DROPEFFECT_NONE	 = 0
Const DROPEFFECT_COPY	 = 1
Const DROPEFFECT_MOVE	 = 2
Const DROPEFFECT_LINK	 = 3
Const DROPEFFECT_SCROLL	 = &h80000000
#endif '------------------------------------


Type IDROPTARGET_NOTIFY
	ppt As POINTAPI				'マウスの位置
	dwEffect As DWord 			'ドラッグ操作で、ドラッグされる対象で許される効果
	grfKeyState As DWord 		'キーの状態
	cfFormat As Word			'ドロップされるデータのクリップボードフォーマット
	hMem As HANDLE 				'ドロップされるデータ
	pdo As VoidPtr				'IDataObject
End Type
TypeDef LPIDROPTARGET_NOTIFY = *IDROPTARGET_NOTIFY
/*
typedef struct _IDROPTARGET_NOTIFY {
	POINTL *ppt;					//マウスの位置
	DWORD dwEffect;					//ドラッグ操作で、ドラッグされる対象で許される効果
	DWORD grfKeyState;				//キーの状態
	UINT cfFormat;					//ドロップされるデータのクリップボードフォーマット
	HANDLE hMem;					//ドロップされるデータ
	LPVOID pdo;						//IDataObject
}IDROPTARGET_NOTIFY , *LPIDROPTARGET_NOTIFY;
*/

/*
//-----------------------------------------------------------------------------
// ウィンドウをDnDのターゲットとして登録する
// IN  hWnd: DnDターゲットとして登録するウィンドウ
//     uCallbackMessage: DnDが行われたときにウィンドウに送信されるメッセージ
//                   送信されるメッセージのパラメータには以下が設定される
//                   wParam: 操作の種類(IDROPTARGET_NOTIFY_MSG)
//                   lParam: IDROPTARGET_NOTIFY構造体へのポインタ
//     cFormat: 受け取ることが可能なクリップボードフォーマットのリスト
//     cfcnt: クリップボードフォーマットの配列の要素数
// OUT ret:登録に成功したか
//-----------------------------------------------------------------------------
*/
Declare Function OLE_IDropTarget_RegisterDragDrop Lib "OleDragDrop.dll" ( 
						ByVal hWnd As HWND, ByVal uCallbackMessage As Word, 
						ByVal cFormat As WordPtr, ByVal cfcnt As Integer ) As Long
'DLLEXPORT BOOL _stdcall OLE_IDropTarget_RegisterDragDrop(HWND hWnd,UINT uCallbackMessage,UINT* cFormat,int cfcnt);
Const WM_DROPNOTIFY	= WM_USER + 100

/*
//-----------------------------------------------------------------------------
// DnDのターゲットを解除する
// IN  hWnd: DnDターゲットとして登録しているウィンドウ
//-----------------------------------------------------------------------------
*/
Declare Sub OLE_IDropTarget_RevokeDragDrop Lib "OleDragDrop.dll" ( ByVal hWnd As HWND )
'DLLEXPORT void _stdcall OLE_IDropTarget_RevokeDragDrop(HWND hWnd);

/* 未宣言
//-----------------------------------------------------------------------------
// DnDを開始する
// IN  hWnd: 以下のデータ要求・DnD終了メッセージを受け取るウィンドウ
//     uCallbackGetData: DnDするデータが必要なときにウィンドウに送信されるメッセージ
//                   送信されるメッセージのパラメータには以下が設定される
//                   wParam: 要求されるクリップボードフォーマットの配列
//                   lParam: データを格納するHANDLEへのポインタ
//                           *(HANDLE*)lParam にデータを設定して返す(NULLでも可)
//     uCallbackDropEnd: DnDが終了したときにウィンドウに送信されるメッセージ
//                   送信されるメッセージのパラメータには以下が設定される
//                   wParam: ドロップ操作が発生した場合はDRAGDROP_S_DROP
//                           キャンセルされたらDRAGDROP_S_CANCEL
//                   lParam: 0
//     ClipFormtList: サポートしているクリップボードフォーマットの配列
//     cfcnt: クリップボードフォーマットの配列の要素数
//     Effect: ドラッグ操作でドラッグされる対象で許される効果の組み合わせ
// OUT ret: ドロップ先のアプリケーションが設定した効果(Cancel/Error時は-1)
//-----------------------------------------------------------------------------
DLLEXPORT int _stdcall OLE_IDropSource_Start(HWND hWnd,UINT uCallbackGetData,UINT uCallbackDropEnd,UINT *ClipFormtList,int cfcnt,int Effect);
*/

/* 未宣言
//-----------------------------------------------------------------------------
// ドロップファイルの作成
// IN  FileName:ファイル名の配列, cnt:ファイル数
// OUT ret:ドロップファイル構造体(HDROP)
//-----------------------------------------------------------------------------
DLLEXPORT HDROP _stdcall CreateDropFileMem(char** FileName,int cnt);
*/

/*
//-----------------------------------------------------------------------------
// ドロップファイル構造体からフルパスファイル名リスト(xxx\0yyy\0\0の形式)を作成
// IN   filelist:ファイル名リストの格納先, bufsize:filelistのサイズ
// OUT  ret:ドロップされたファイル数
//-----------------------------------------------------------------------------
*/
Declare Function GetDropFileList Lib "OleDragDrop.dll" ( 
										ByVal hDrop As HDROP, 
										ByVal filelist As BytePtr,
										ByVal bufsize As Integer ) As Integer
'DLLEXPORT int _stdcall GetDropFileList(HDROP hDrop,char* filelist,int bufsize);



#endif




Declare Function OleInitialize Lib "Ole32" ( reserved As VoidPtr) As Long
Declare Sub OleUninitialize Lib "Ole32" ()

コード: 全て選択

'-----------------------------------------------------------------------------
' OLEドロップのターゲット登録
' IN  hwnd:OLEドロップのターゲットとして登録するウィンドウ
'-----------------------------------------------------------------------------
Sub OleDnDInit( hWnd As HWND)
	Dim cf[10] As Word '10は便宜上
	cf[0] = CF_TEXT
	cf[1] = CF_HDROP

	DragAcceptFiles( hWnd, FALSE )

	OleInitialize( NULL )
	OLE_IDropTarget_RegisterDragDrop( hWnd, WM_DROPNOTIFY, cf, 10 )
End Sub

'-----------------------------------------------------------------------------
' OLEドロップのターゲット破棄
' IN  hwnd:OLEドロップのターゲットとして登録してあるウィンドウ
'-----------------------------------------------------------------------------
Sub OleDnDUninit( hWnd As HWND )
	OLE_IDropTarget_RevokeDragDrop( hWnd )
	OleUninitialize()
	DragAcceptFiles( hWnd, TRUE )
End Sub


'-----------------------------------------------------------------------------
' ドラッグ中カーソルがウィンドウ内に入ってきた
'-----------------------------------------------------------------------------
Function OleDropTarget_OnDragEnter( hWnd As HWND, pDrop As LPIDROPTARGET_NOTIFY, ByRef cf As Word ) As Long
End Function

'-----------------------------------------------------------------------------
' ドラッグ中カーソルがウィンドウ内で動いた
'-----------------------------------------------------------------------------
Function OleDropTarget_OnDragOver( hWnd As HWND, pDrop As LPIDROPTARGET_NOTIFY, ByRef cf As Word ) As Long

	If( cf=CF_HDROP )Then	' クリップボードフォーマットが CF_HDROP
		pDrop->dwEffect = DROPEFFECT_COPY
	Else
		pDrop->dwEffect = DROPEFFECT_NONE
	End If

	OleDropTarget_OnDragOver = TRUE
End Function

'-----------------------------------------------------------------------------
' ドラッグ中カーソルがウィンドウ外に出た
'-----------------------------------------------------------------------------
Function OleDropTarget_OnDragLeave( hWnd As HWND, pDrop As LPIDROPTARGET_NOTIFY, ByRef cf As Word ) As Long
	OleDropTarget_OnDragLeave = TRUE
End Function


'-----------------------------------------------------------------------------
' ウィンドウ内でドロップされた
'-----------------------------------------------------------------------------
Const Ole_DragDropList_MAX_SIZE = MAX_PATH*1000
Function OleDropTarget_OnDrop( hWnd As HWND, pDrop As LPIDROPTARGET_NOTIFY, ByRef cf As Word ) As Long
	Dim pFileList As BytePtr
	Dim nListNum As Long

	Select Case pDrop->cfFormat
		Case CF_HDROP
			SetForegroundWindow( hWnd )
			pFileList = calloc( Ole_DragDropList_MAX_SIZE )
			If( pFileList=NULL )Then
				ExitFunction
			End If
			nListNum = GetDropFileList( pDrop->hMem As HDROP, pFileList, Ole_DragDropList_MAX_SIZE As Integer )

			free( pFileList )
	End Select

	OleDropTarget_OnDrop = TRUE
End Function



'-----------------------------------------------------------------------------
' OLEドロップのNOTIFY処理
'-----------------------------------------------------------------------------
Sub OnOleDropTargetNotify( hWnd As HWND, nMsg_ROPTARGET_NOTIFY As Word, pIDROPTARGET_NOTIFY As LPIDROPTARGET_NOTIFY )
	Dim cf As Word
	cf = 0
	Select Case nMsg_ROPTARGET_NOTIFY
		Case IDROPTARGET_NOTIFY_DRAGENTER
OutputDebugString(Ex"DragEnter\r\n")
			cf = pIDROPTARGET_NOTIFY->cfFormat
			OleDropTarget_OnDragEnter( hWnd, pIDROPTARGET_NOTIFY, cf )
		Case IDROPTARGET_NOTIFY_DRAGOVER
OutputDebugString(Ex"DragOver\r\n")
			OleDropTarget_OnDragOver( hWnd, pIDROPTARGET_NOTIFY, cf )
		Case IDROPTARGET_NOTIFY_DRAGLEAVE
OutputDebugString(Ex"DragLeave\r\n")
			OleDropTarget_OnDragLeave( hWnd, pIDROPTARGET_NOTIFY, cf )
		Case IDROPTARGET_NOTIFY_DROP
'問題点：なぜか、ここだけが呼ばれない･･･。
OutputDebugString(Ex"DragDrop\r\n")
MsgBox hMainWnd, "ドロップされました"
			OleDropTarget_OnDrop( hWnd, pIDROPTARGET_NOTIFY, cf )
	End Select
End Sub

コード: 全て選択

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	Select Case dwMsg
		Case WM_DROPNOTIFY
			OnOleDropTargetNotify( hWnd, wParam As Word, lParam As LPIDROPTARGET_NOTIFY )
	End Select

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function


'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
	OleDnDUninit( hMainWnd )

	OleDragDrop_UseDll_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	OleDnDInit( hMainWnd )
End Sub

コード: 全て選択

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

コード: 全て選択

	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")

		Dim fe As FORMATETC
		Dim medium As STGMEDIUM
		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
			Dim hglMem As HGLOBAL
			hglMem = medium.data As HGLOBAL
			MessageBox(hwnd, GlobalLock(hglMem) As BytePtr, "ドロップされました", MB_OK)
			GlobalUnlock(medium.data)
			ReleaseStgMedium(medium)

			effect = DROPEFFECT_COPY
		Else
			MessageBox(hwnd, "よくわからない形式のデータです。", "ドロップされました", MB_OK)
			effect = DROPEFFECT_NONE
		End If
		Drop = S_OK
	End Function

コード: 全て選択

/*　---------------------------------------------------
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

提供：イグトランス様
実際に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

提供：イグトランス様
「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

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