home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Advanced_F206388542007.psc / dragdrop.bas < prev    next >
BASIC Source File  |  2007-04-30  |  3KB  |  81 lines
  1. Attribute VB_Name = "Module1"
  2. Private Const WM_DROPFILES = &H233
  3. '&H233 is the windows message id for the drop files message.
  4. 'It is the value of the uMsg parameter in the window procedure call.
  5.  
  6. Private Const GWL_WNDPROC = (-4)
  7. 'The index parameter to the SetWindowLong function
  8. 'that specifies to change a windows message handler procedure.
  9.  
  10. Private Declare Sub DragAcceptFiles Lib "shell32.dll" _
  11. (ByVal hwnd As Long, ByVal fAccept As Long)
  12. 'DragAcceptFiles enables or disables a form or window to accept files.
  13. 'fAccept = 1 Enables.
  14.  
  15. Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" _
  16. (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
  17. 'DragQueryFile gives the information to us about the dropped file.
  18. 'lpStr outputs the filename.
  19.  
  20. Private Declare Sub DragFinish Lib "shell32.dll" _
  21. (ByVal HDROP As Long)
  22. 'This function frees the resources used during the drag operation
  23.  
  24. Private PrevProc As Long
  25. 'Variable to store the address of the default window procedure
  26.  
  27. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  28. (ByVal hwnd As Long, ByVal nIndex As Long, _
  29. ByVal dwNewLong As Long) As Long
  30.  
  31. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
  32. (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
  33. ByVal msg As Long, ByVal wParam As Long, _
  34. ByVal lParam As Long) As Long
  35.  
  36. Private Function HookForm(ByVal hwnd As Long)
  37.     PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
  38.  'Setting our new windowProc function, now all message to window goes through WindowProc.
  39.  'Return value is the address of the previous function. ie,
  40.  'the AddressOf default window proc function
  41. End Function
  42. 'Our Custom WindowProc Function
  43. Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  44.     If uMsg = WM_DROPFILES Then 'If we have got a drop
  45.         Dropped wParam 'wparam stores the Hdrop handle
  46.     End If
  47.     WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
  48. 'Call the default window procedure !IMPORTANT
  49. End Function
  50.  
  51. 'Remove our default window procedure.
  52. Private Function UnHookForm(ByVal hwnd As Long)
  53.     If PrevProc <> 0 Then
  54.         SetWindowLong hwnd, GWL_WNDPROC, PrevProc
  55.         PrevProc = 0
  56.     End If
  57. End Function
  58.  
  59. ''' interface api '''
  60. Public Sub EnableDragDrop(ByVal hwnd As Long)
  61.     DragAcceptFiles hwnd, 1
  62.     HookForm (hwnd)
  63. End Sub
  64.  
  65. Public Sub DisableDragDrop(ByVal hwnd As Long)
  66.     DragAcceptFiles hwnd, 0
  67.     UnHookForm hwnd
  68. End Sub
  69.  
  70. Public Sub Dropped(ByVal HDROP As Long)
  71.     Dim strFilename As String * 511
  72.     Call DragQueryFile(HDROP, 0, strFilename, 511) 'Get the filename.
  73.     
  74.     '!! replace with your function below ....
  75.     Form1.GotADrop (strFilename)
  76.         Call DragQueryFile(HDROP, 2, strFilename, 511)
  77. End Sub
  78.  
  79.  
  80.  
  81.