Функция DragAcceptFiles

Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long)

DragAcceptFiles регистрирует, может ли окно принимать файлы с помощью drag'n'drop

Возвращаемое значение

DragAcceptFiles не возвращает значений

Параметры

hwnd
Описатель окна
fAccept
Значение, показывающее возможность окном принимать перетаскиваемые файлы с помощью drag'n'drop. Если TRUE, то может принимать, если FALSE, то не может

Пример

' Создаем возможность принимать перетаскиваемые файлы
' нашей формой
' Разместите код в модуле
Public Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long)
Public 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 Const GWL_WNDPROC = (-4)
Private Const WM_DROPFILES = &H233
Global p&

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_DROPFILES Then
        Dim Str_Name As String * &HFF, Lng_File&
        Lng_File = DragQueryFile(wParam, True, Str_Name, 0)
        Form1.Cls
        Form1.Print "Всего: " & Lng_File
        For Lng_File = 0 To Lng_File - 1
            DragQueryFile ByVal wParam, Lng_File, Str_Name, Len(Str_Name)
            Form1.Print vbTab & Replace(Str_Name, vbNullChar, vbNullString)
        Next
    End If
    WindowProc =  CallWindowProc(p, hwnd, uMsg, wParam, lParam)
End Function

' Добавьте код в Form_Load
Form1.Caption = "Перетащите на форму пару файлов"
p = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
DragAcceptFiles hwnd, True

Категория

Drag'n'Drop