B
benyod79 via AccessMonster.com
I'm having a problem with the drag and drop code from MVPS API: Drag and Drop
from Explorer. The form loads fine and copies the file location as it is
dropped. However, it the form is 'stuck' and won't respond to any else
besides dropping files to it. I've made a couple modifications, but
everything looks like it should work properly. I'm hoping you'll be able to
find the piece that I'm overlooking. Thanks for your help!
Dave
- A2000
- IE7
Form: frmDragDrop (listbox "lstDrop")
Code:
Option Compare Database
'************* Code Start *************
Private Sub Form_Open(Cancel As Integer)
Call sEnableDrop(Me)
Call sHook(Me.Hwnd) 'Formerly Call sHook(Me.Hwnd, "sDragDrop")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call sUnhook(Me.Hwnd)
End Sub
'************* Code End *************
Module: basDragDrop
Code:
Option Compare Database
'************* Code Start *************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiCallWindowProc 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
Private Declare Function apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) _
As Long
Private Declare Function apiGetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long) _
As Long
Private Declare Sub sapiDragAcceptFiles Lib "shell32.dll" _
Alias "DragAcceptFiles" _
(ByVal Hwnd As Long, _
ByVal fAccept As Long)
Private Declare Sub sapiDragFinish Lib "shell32.dll" _
Alias "DragFinish" _
(ByVal hDrop As Long)
Private Declare Function apiDragQueryFile Lib "shell32.dll" _
Alias "DragQueryFileA" _
(ByVal hDrop As Long, _
ByVal iFile As Long, _
ByVal lpszFile As String, _
ByVal cch As Long) _
As Long
Private lpPrevWndProc As Long
Private Const GWL_WNDPROC As Long = (-4)
Private Const GWL_EXSTYLE = (-20)
Private Const WM_DROPFILES = &H233
Private Const WS_EX_ACCEPTFILES = &H10&
Private hWnd_Frm As Long
Sub sDragDrop(ByVal Hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long)
Dim lngRet As Long, strTmp As String, intLen As Integer
Dim lngCount As Long, i As Long, strOut As String
Const cMAX_SIZE = 50
On Error Resume Next
If Msg = WM_DROPFILES Then
strTmp = String$(255, 0)
lngCount = apiDragQueryFile(wParam, &HFFFFFFFF, strTmp, Len(strTmp))
For i = 0 To lngCount - 1
strTmp = String$(cMAX_SIZE, 0)
intLen = apiDragQueryFile(wParam, i, strTmp, cMAX_SIZE)
strOut = strOut & Left$(strTmp, intLen) & ";"
Next i
strOut = Left$(strOut, Len(strOut) - 1)
Call sapiDragFinish(wParam)
With Forms!frmDragDrop!lstDrop
.RowSourceType = "Value List"
.RowSource = strOut
Forms!frmDragDrop.Caption = "DragDrop: " & _
.ListCount & _
" files dropped."
End With
Else
lngRet = apiCallWindowProc( _
ByVal lpPrevWndProc, _
ByVal Hwnd, _
ByVal Msg, _
ByVal wParam, _
ByVal lParam)
End If
End Sub
Sub sEnableDrop(frm As Form)
Dim lngStyle As Long, lngRet As Long
lngStyle = apiGetWindowLong(frm.Hwnd, GWL_EXSTYLE)
lngStyle = lngStyle Or WS_EX_ACCEPTFILES
lngRet = apiSetWindowLong(frm.Hwnd, GWL_EXSTYLE, lngStyle)
Call sapiDragAcceptFiles(frm.Hwnd, True)
hWnd_Frm = frm.Hwnd
End Sub
Sub sHook(Hwnd As Long)
lpPrevWndProc = apiSetWindowLong(Hwnd, GWL_WNDPROC, AddressOf sDragDrop)
'**************Formerly *******************
'Sub sHook(Hwnd As Long, strFunction as String)
'lpPrevWndProc = apiSetWindowLong(Hwnd, GWL_WNDPROC, AddrOf (strFunction))
'********************************************
End Sub
Sub sUnhook(Hwnd As Long)
Dim lngTmp As Long
lngTmp = apiSetWindowLong(Hwnd, _
GWL_WNDPROC, _
lpPrevWndProc)
lpPrevWndProc = 0
End Sub
'**************** Code End ***************
from Explorer. The form loads fine and copies the file location as it is
dropped. However, it the form is 'stuck' and won't respond to any else
besides dropping files to it. I've made a couple modifications, but
everything looks like it should work properly. I'm hoping you'll be able to
find the piece that I'm overlooking. Thanks for your help!
Dave
- A2000
- IE7
Form: frmDragDrop (listbox "lstDrop")
Code:
Option Compare Database
'************* Code Start *************
Private Sub Form_Open(Cancel As Integer)
Call sEnableDrop(Me)
Call sHook(Me.Hwnd) 'Formerly Call sHook(Me.Hwnd, "sDragDrop")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call sUnhook(Me.Hwnd)
End Sub
'************* Code End *************
Module: basDragDrop
Code:
Option Compare Database
'************* Code Start *************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiCallWindowProc 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
Private Declare Function apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) _
As Long
Private Declare Function apiGetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long) _
As Long
Private Declare Sub sapiDragAcceptFiles Lib "shell32.dll" _
Alias "DragAcceptFiles" _
(ByVal Hwnd As Long, _
ByVal fAccept As Long)
Private Declare Sub sapiDragFinish Lib "shell32.dll" _
Alias "DragFinish" _
(ByVal hDrop As Long)
Private Declare Function apiDragQueryFile Lib "shell32.dll" _
Alias "DragQueryFileA" _
(ByVal hDrop As Long, _
ByVal iFile As Long, _
ByVal lpszFile As String, _
ByVal cch As Long) _
As Long
Private lpPrevWndProc As Long
Private Const GWL_WNDPROC As Long = (-4)
Private Const GWL_EXSTYLE = (-20)
Private Const WM_DROPFILES = &H233
Private Const WS_EX_ACCEPTFILES = &H10&
Private hWnd_Frm As Long
Sub sDragDrop(ByVal Hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long)
Dim lngRet As Long, strTmp As String, intLen As Integer
Dim lngCount As Long, i As Long, strOut As String
Const cMAX_SIZE = 50
On Error Resume Next
If Msg = WM_DROPFILES Then
strTmp = String$(255, 0)
lngCount = apiDragQueryFile(wParam, &HFFFFFFFF, strTmp, Len(strTmp))
For i = 0 To lngCount - 1
strTmp = String$(cMAX_SIZE, 0)
intLen = apiDragQueryFile(wParam, i, strTmp, cMAX_SIZE)
strOut = strOut & Left$(strTmp, intLen) & ";"
Next i
strOut = Left$(strOut, Len(strOut) - 1)
Call sapiDragFinish(wParam)
With Forms!frmDragDrop!lstDrop
.RowSourceType = "Value List"
.RowSource = strOut
Forms!frmDragDrop.Caption = "DragDrop: " & _
.ListCount & _
" files dropped."
End With
Else
lngRet = apiCallWindowProc( _
ByVal lpPrevWndProc, _
ByVal Hwnd, _
ByVal Msg, _
ByVal wParam, _
ByVal lParam)
End If
End Sub
Sub sEnableDrop(frm As Form)
Dim lngStyle As Long, lngRet As Long
lngStyle = apiGetWindowLong(frm.Hwnd, GWL_EXSTYLE)
lngStyle = lngStyle Or WS_EX_ACCEPTFILES
lngRet = apiSetWindowLong(frm.Hwnd, GWL_EXSTYLE, lngStyle)
Call sapiDragAcceptFiles(frm.Hwnd, True)
hWnd_Frm = frm.Hwnd
End Sub
Sub sHook(Hwnd As Long)
lpPrevWndProc = apiSetWindowLong(Hwnd, GWL_WNDPROC, AddressOf sDragDrop)
'**************Formerly *******************
'Sub sHook(Hwnd As Long, strFunction as String)
'lpPrevWndProc = apiSetWindowLong(Hwnd, GWL_WNDPROC, AddrOf (strFunction))
'********************************************
End Sub
Sub sUnhook(Hwnd As Long)
Dim lngTmp As Long
lngTmp = apiSetWindowLong(Hwnd, _
GWL_WNDPROC, _
lpPrevWndProc)
lpPrevWndProc = 0
End Sub
'**************** Code End ***************