|
-
May 19th, 2013, 05:43 AM
#1
Thread Starter
Banned
Allowing a Visual Basic Application to Accept Drag-and-Drop Files
Tip 86: Allowing a Visual Basic Application to Accept Drag-and-Drop Files
May 15, 1995
Abstract
Many Windows®-based applications can accept, or process, a file that has been dragged from File Manager. This article explains how you can add this feature to your own Visual Basic® application.
Code:
Using MSGBLAST.VBX to Accept Drag-and-Drop Files
Using File Manager, you can drag a file to another application and, when you release the mouse button (drop the file), the target application can process the file any way it wants to.
In order for a program to be able to accept drag-and-drop files, however, the program must have a method of recognizing when a file has been sent to it. In Visual Basic®, this can be done by using the Message Blaster custom control and three Windows® application programming interface (API) functions: DragAcceptFiles, DragQueryFile, and DragFinish.
The DragAcceptFiles function tells Windows that a specific window (that is, your Visual Basic application's form) can accept files dropped from File Manager. The Declare statement for this function is:
Private Declare Sub DragAcceptFiles Lib "shell" (ByVal hWnd As Integer, ByVal
bool As Integer)
(Note that this Declare statement must be typed as a single line of code.)
The DragAcceptFiles function takes only two arguments: the handle of the window that will accept the dropped files, and an integer value that specifies if the file can be accepted or ignored. If the Boolean argument is set to True, the window can accept dropped files; if it is set to zero, the window can no longer accept dropped files.
You can retrieve the name of the file that was dropped on the target window by calling the DragQueryFile function. This function's declaration statement is:
Private Declare Function DragQueryFile Lib "shell" (ByVal wParam As Integer,
ByVal Index As Integer, ByVal lpszFile As Any, ByVal BufferSize As Integer)
As Integer
(Note that this Declare statement must be typed as a single line of code.)
DragQueryFile requires four arguments, as follows:
wParam An integer value that contains the internal data structure's handle. This is provided by the WM_DROPFILES message.
Index An integer value containing the number of the individual file to be retrieved. If this value is -1, the number of files listed in the wParam structure will be returned.
lpszFile A string buffer that contains the name of the dropped file.
BufferSize An integer value containing the maximum number of characters in lpszFile.
After calling the DragQueryFile function, an integer value reports the status of the function. This value contains the number of characters copied to the lpszFile string or the number of files available if Index was set to zero.
The third function needed to work with drag-and-drop files is the DragFinish function. This function simply requires that the internal data structure's handle be passed to it. DragFinish frees all structures used when transferring the file to the target application.
The final step is to process the WM_DROPFILES message. This message is sent by Windows each time it needs to send a drag-and-drop request to a program. In your Visual Basic program you need only use the Message Blaster custom control to intercept the WM_DROPFILES message before Windows actually processes it itself. In the example program below, we use the Message Blaster control to retrieve the name of the dropped file and store that name in the List Box control.
Example Program
The example program below shows how to allow your Visual Basic application to accept drag-and-drop files from File Manager. To use this demonstration program, first execute the Windows Explorer or File Manager application. Then run the DEMO.EXE program. When you drag a file from File Manager to DEMO.EXE's window and release the mouse button, the filename will be displayed in the List Box control.
Create a new project in Visual Basic. Form1 is created by default.
Add the following code to the General Declarations section of Form1 (note that each Declare statement must be typed as a single line of code):
Option Explicit
Private Declare Sub DragAcceptFiles Lib "shell" (ByVal hWnd As Integer, ByVal
bool As Integer)
Private Declare Function DragQueryFile Lib "shell" (ByVal wParam As Integer,
ByVal Index As Integer, ByVal lpszFile As Any, ByVal BufferSize As Integer)
As Integer
Private Declare Sub DragFinish Lib "shell" (ByVal hDrop As Integer)
Const WM_DROPFILES = &H233
Add the following code to the Form_Load event for Form1:
Private Sub Form_Load()
msgblaster1.MsgList(0) = WM_DROPFILES
msgblaster1.hWndTarget = Me.hWnd
msgblaster1.MsgPassage(0) = 1
DragAcceptFiles Me.hWnd, True
End Sub
Add a Message Blaster custom control to Form1. MsgBlaster1 is created by default.
Add the following code to the MsgBlaster1_Message event for MsgBlaster1:
Private Sub MsgBlaster1_Message(MsgVal As Integer, wParam As Integer, lParam As
Long, ReturnVal As Long)
Dim hFilesInfo As Integer
Dim szFileName As String
hFilesInfo = wParam
wTotalFiles = DragQueryFile(hFilesInfo, &HFFFF, ByVal 0&, 0)
For wIndex = 0 To wTotalFiles
szFileName = Space$(50)
Retv% = DragQueryFile(hFilesInfo, wIndex, szFileName, 50)
list1.AddItem szFileName
Next wIndex
DragFinish (hFilesInfo)
End Sub
Compile the program. From Visual Basic's File menu, select Make EXE File to create the executable file called DEMO.EXE.
need help making this source
-
May 19th, 2013, 08:18 AM
#2
Re: Allowing a Visual Basic Application to Accept Drag-and-Drop Files
Most controls has OLEDragDrop event which you can use to open dragged file(s)
Try this
Code:
Option Explicit
Private Sub Form_Load()
Me.OLEDropMode = 1
End Sub
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim j As Long
If Data.GetFormat(vbCFFiles) = True Then
If Not (GetAttr(Data.Files.Item(1)) And vbDirectory) Then
' To open only one file
' OpenFile(Data.Files.Item(1))
' To open multi files
For j = 1 To Data.Files.Count
' OpenFile(Data.Files.Item(j))
MsgBox Data.Files.Item(j)
Next
End If
End If
End Sub
Private Sub Form_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
If Data.GetFormat(vbCFFiles) = True Then
If (GetAttr(Data.Files.Item(1)) And vbDirectory) Then ' don't accept folders
Effect = vbDropEffectNone
Else
Effect = vbDropEffectCopy
End If
End If
End Sub
-
May 19th, 2013, 04:42 PM
#3
Re: Allowing a Visual Basic Application to Accept Drag-and-Drop Files
Code:
'Add a ListBox to a blank Form
'Set List1.IntegralHeight = False
Option Explicit
Private Const RIGHT_MARGIN As Long = 5 'Right margin for List1's longest item (in pixels)
Private Const LB_SETHORIZONTALEXTENT As Long = &H194
Private Declare Function DragQueryFileW Lib "shell32.dll" (ByVal hDrop As Long, ByVal iFile As Long, Optional ByVal lpszFile As Long, Optional ByVal cch As Long) As Long
Private Declare Function SendMessageW Lib "user32.dll" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd As Long, ByVal fAccept As Long)
Private Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Long)
Public Sub Drag_n_Drop(ByVal hDrop As Long)
Dim i As Long, sngLongestText As Single, TW As Single, sBuffer As String
With List1
i = DragQueryFileW(hDrop, &HFFFFFFFF)
If i Then
.Visible = False
.Clear
For i = 0& To i - 1&
SysReAllocStringLen VarPtr(sBuffer), , DragQueryFileW(hDrop, i)
DragQueryFileW hDrop, i, StrPtr(sBuffer), Len(sBuffer) + 1&
.AddItem sBuffer
TW = TextWidth(sBuffer)
If sngLongestText < TW Then sngLongestText = TW
Next
.Visible = True
SendMessageW .hWnd, LB_SETHORIZONTALEXTENT, RIGHT_MARGIN + sngLongestText, 0&
End If
DragFinish hDrop
End With
End Sub
Private Sub Form_Load()
ScaleMode = vbPixels
DragAcceptFiles hWnd, 1& 'fAccept:=TRUE
Subclass Me
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then List1.Move ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight
End Sub
Code:
'In a BAS module
Option Explicit
Private Const WM_DESTROY As Long = &H2
Private Const WM_DROPFILES As Long = &H233
Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Public Function Subclass(ByRef Frm As Form) As Boolean
Subclass = SetWindowSubclass(Frm.hWnd, AddressOf SubclassProc, ObjPtr(Frm), AddressOf SubclassProc) <> 0&
Debug.Assert Subclass
End Function
Private Function SubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _
ByVal uIdSubclass As Form, ByVal dwRefData As Long) As Long
Select Case uMsg
Case WM_DROPFILES: uIdSubclass.Drag_n_Drop wParam
Exit Function
Case WM_DESTROY: dwRefData = RemoveWindowSubclass(hWnd, dwRefData, ObjPtr(uIdSubclass))
Debug.Assert dwRefData
End Select
SubclassProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)
-
May 20th, 2013, 02:00 AM
#4
Thread Starter
Banned
Re: Allowing a Visual Basic Application to Accept Drag-and-Drop Files
thanks guys awsome , thanks bonnie
-
May 21st, 2013, 02:09 AM
#5
Thread Starter
Banned
Re: Allowing a Visual Basic Application to Accept Drag-and-Drop Files
can anyone help me with this, when i drag txt file i want it to populate all strings from that txt to listbox thanks
currently it adds path to the files tht gets dragged into list1
-
May 21st, 2013, 06:46 AM
#6
Re: Allowing a Visual Basic Application to Accept Drag-and-Drop Files
When you get the dragged file name, pass it to a procedure to open it and read its contents and put inside the listbox.
Try this
Code:
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim j As Long
If Data.GetFormat(vbCFFiles) = True Then
If Not (GetAttr(Data.Files.Item(1)) And vbDirectory) Then
' To open only one file
OpenFile(Data.Files.Item(1))
' To open multi files
'For j = 1 To Data.Files.Count
' OpenFile(Data.Files.Item(j))
' MsgBox Data.Files.Item(j)
'Next
End If
End If
End Sub
Private Sub OpenFile(ByVal strFile As String)
Dim intFN As Integer
Dim strIN As String
On Error GoTo errIOError
intFN = FreeFile
Open strFile For Input As #intFN
Do While Not EOF(intFN)
Line Input #intFN, strIN
strIN = Trim$(strIN)
If LenB(strIN) <> 0 Then
List1.AddItem strIN
End If
Loop
Close #intFN
Exit Sub
errIOError:
Close #intFN
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|