Visual Basic File Routines
DragAcceptFiles: File Drag/Drop in VB
     
Posted:   Thursday December 26, 1996
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   Joseph J Guadagno
     
 Prerequisites
None. Note that this page pre-dated the availability of VB's easier OLE drag/drop methods.

Code taken from the web, authored by Joseph J Guadagno, Bethpage, NY.

Note that beginning with VB5 the OLEDragDrop and related routines provide increased functionality and simpler code than this VB4-32 method.

 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Type POINTAPI
   x As Long
   y As Long
End Type
 

Public Type MSG
   hWnd As Long
   message As Long
   wParam As Long
   lParam As Long
   time As Long
   pt As POINTAPI
End Type

Public Declare Sub DragAcceptFiles Lib "shell32" _ 
  (ByVal hWnd As Long, _
   ByVal fAccept As Long)

Public Declare Sub DragFinish Lib "shell32" _
  (ByVal hDrop As Long)

Public Declare Function DragQueryFile Lib "shell32" _
   Alias "DragQueryFileA" _
  (ByVal hDrop As Long, _
   ByVal UINT As Long, _
   ByVal lpStr As String, _
   ByVal ch As Long) As Long

Public Declare Function PeekMessage Lib "user32" _
   Alias "PeekMessageA" _
  (lpMsg As MSG, _
   ByVal hWnd As Long, _
   ByVal wMsgFilterMin As Long, _
   ByVal wMsgFilterMax As Long, _
   ByVal wRemoveMsg As Long) As Long

Public Const PM_NOREMOVE = &H0
Public Const PM_NOYIELD = &H2
Public Const PM_REMOVE = &H1
Public Const WM_DROPFILES = &H233


Public Sub Main()
  
  'In order for this to function properly you should place of of your program
  'execution code in the Sub Main(), Make sure you change the project startup
  'to sub Main  
   Form1.Show
  
  'This must be the last line! Nothing gets called after this  
   WatchForFiles

End Sub


Public Sub WatchForFiles()
   
  'This watches for all WM_DROPFILES messages

   Dim FileDropMessage As MSG    'Msg Type
   Dim fileDropped As Boolean    'True if Files where dropped
   Dim hDrop As Long             'Pointer to the dropped file structure
   Dim filename As String * 128  'the dropped filename
   Dim numOfDroppedFiles As Long 'the number of dropped files
   Dim curFile As Long           'the current file number
   
  'loop to keep checking for files
  'NOTE: Do any code you want to execute before this set
   
   Do
      
      'check for Dropped file messages
       fileDropped = PeekMessage(FileDropMessage, 0, _
                     WM_DROPFILES, WM_DROPFILES, PM_REMOVE Or PM_NOYIELD)

       If fileDropped Then
         
         'get the pointer to the dropped file structure
          hDrop = FileDropMessage.wParam
         
         'get the total number of files
          numOfDroppedFiles = DragQueryFile(hDrop, True, filename, 127)

          For curFile = 1 To numOfDroppedFiles
             
             'get the file name
              Call DragQueryFile(hDrop, curFile - 1, filename, 127)
             
             'at this pointer you can do what you want with the filename
             'the filename will be a full qualified path
              Form1.lblNumDropped = LTrim$(Str$(numOfDroppedFiles))
              Form1.List1.AddItem filename

          Next curFile
         
         'we are now done with the structure, tell windows to discard it
          DragFinish (hDrop)

      End If
  
     'be nice 
      DoEvents

   Loop

End Sub
 Form Code
On a form, add three command buttons, a listbox and a label. Add the following code to the form:

Option Explicit

Private Sub Command1_Click()

  'You can turn the form's / controls ability 
  'to accept the files by passing DragAcceptFiles 
  'the hWnd as the first parameter and True/False 
  'as the second parameter
   If Command1.Caption = "&Accept Files" Then
      
     'allow the application to accept files
      DragAcceptFiles Form1.hWnd, True
      Command1.Caption = "&Do Not Accept"

   Else

      DragAcceptFiles Form1.hWnd, False
      Command1.Caption = "&Accept Files"

   End If

End Sub


Private Sub Command2_Click()
  
  'Clears the contents of the list box
   List1.Clear

End Sub


Private Sub Command3_Click()
  
  'end the program
   Unload Me

End Sub
 Comments
Run the project. Open Explorer, and press the Accept Files button (Command1). Drag any number of files from explorer onto the form's listbox and release. The full path and filename of each file dropped will be displayed.

Pressing Do Not Accept turns off the drag drop sensing.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

 

Hit Counter