VBの組み込み機能を利用する方法とAPI関数を利用した方法の2通りを書いておく。ここではフォームにファイルをドラッグ&ドロップすることを前提とする。
まずはVBの機能を利用する方法。フォームの OLEDropMode プロパティの値を「1 - 手動」 に設定し、以下のコードを記述する。とっても簡単である。
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, _ Button As Integer, Shift As Integer, X As Single, Y As Single) Dim FileCount As Long 'ファイル総数を格納 Dim i As Long 'ドロップされたものがファイルであるか判定 If Data.GetFormat(vbCFFiles) Then 'ドロップされたファイル数を取得 FileCount = Data.Files.Count 'Filesコレクションの配列から、ファイル名を1つずつ取り出す For i = 1 To FileCount 'ドロップされたファイルの名前をリストボックスに出力 Debug.Print Data.Files(i) Next i End If End Sub
API関数を利用するとたちまちコードの量が多くなる。
Private Type POINTAPI X As Long Y As Long End Type
'デフォルトのウィンドウ・プロシージャを呼ぶ
'ウィンドウの属性を設定する
'ドロップファイルの受け入れ登録
'Windowsがファイル名をアプリケーションに転送するために割り当てたメモリーを解放
'ドロップファイルのファイル名、個数取得
'ドロップされたときのカーソルのウインドウ座標を取得
Private Const WM_DROPFILES = &H233 'ドロップメッセージ Private Const GWL_WNDPROC = (-4) 'ウインドウプロシージャ Private OldWindowhWnd As Long '前回のウインドウプロシージャ '----------------------------------------------------------------------- ' 関数名 : SubClass ' 機能 : サブクラス化を開始する ' 引数 : (in) hWnd … コールバック対象となるウインドウのハンドル ' 戻り値 : なし '----------------------------------------------------------------------- Public Function SubClass(ByVal hWnd As Long) As Long OldWindowhWnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc) SubClass = OldWindowhWnd End Function '----------------------------------------------------------------------- ' 関数名 : UnSubClass ' 機能 : サブクラス化を終了する ' 引数 : (in) hWnd … コールバック対象となるウインドウのハンドル ' 戻り値 : なし '----------------------------------------------------------------------- Public Sub UnSubClass(ByVal hWnd As Long) Dim FuncRet As Long If OldWindowhWnd <> 0 Then '元のプロシージャアドレスに設定する FuncRet = SetWindowLong(hWnd, GWL_WNDPROC, OldWindowhWnd) OldWindowhWnd = 0 End If End Sub '----------------------------------------------------------------------- ' 関数名: StartDragDrop ' 機能 : ファイルのドラッグ&ドロップ受け入れを開始する ' 引数 : (in) hWnd … ドラッグ&ドロップ対象となるウインドウのハンドル ' 返り値: なし '----------------------------------------------------------------------- Public Sub StartDragDrop(ByVal hWnd As Long) Call DragAcceptFiles(hWnd, True) End Sub '----------------------------------------------------------------------- ' 関数名:WindowProc ' 機 能:いわずとしれたウインドウプロシージャ '----------------------------------------------------------------------- Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Dim FileCount As Long Dim FileName As String * 256 Dim i As Long Dim udtPoint As POINTAPI Select Case uMsg Case WM_DROPFILES 'ドロップファイル数取得 FileCount = DragQueryFile(wParam, -1, vbNullString, 0&) 'ドロップファイル名取得 For i = 0 To FileCount - 1 Call DragQueryFile(wParam, i, FileName, Len(FileName)) Debug.Print Left$(FileName, InStr(FileName, Chr$(0)) - 1) Next i 'ついでにドロップされた際のカーソルの座標を取得 Call DragQueryPoint(wParam, udtPoint) Debug.Print udtPoint.x & "," & udtPoint.y & " の位置にドロップされました。" '割り当てられていたメモリーを開放する Call DragFinish(wParam) End Select WindowProc = CallWindowProc(OldWindowhWnd, hWnd, uMsg, wParam, lParam) End Function 以下の通りに呼ぶ。
Private Sub Form_Load() 'フォームがドロップファイルを受け入れるよう設定 Call StartDragDrop(frmMain.hWnd) 'サブクラスの設定 Call SubClass(frmMain.hWnd) End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) 'サブクラスの解除 Call UnSubClass(frmMain.hWnd) End Sub |