● ドラッグ&ドロップを受け付ける ●

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

'デフォルトのウィンドウ・プロシージャを呼ぶ
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'ウィンドウの属性を設定する
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'ドロップファイルの受け入れ登録
Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd As Long, ByVal fAccept As Long)

'Windowsがファイル名をアプリケーションに転送するために割り当てたメモリーを解放
Private Declare Sub DragFinish Lib "shell32.dll" (ByVal HDROP As Long)

'ドロップファイルのファイル名、個数取得
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long

'ドロップされたときのカーソルのウインドウ座標を取得
Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal HDROP As Long, lpPoint As POINTAPI) As Long

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

戻る