Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access
|
Access Discussion of Microsoft Access database design and programming. See also the forums for Access ASP and Access VBA.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old January 2nd, 2012, 03:14 PM
Authorized User
 
Join Date: Jul 2007
Posts: 22
Thanks: 0
Thanked 0 Times in 0 Posts
Default API: Drag and Drop from Explorer to a text box

Hi There,

The following code does the job, but some times when I try to open the form the computer freezes and I have to kill the process to get out of this situation.
I'm using Access 2003.

Any Idea what makes it to happen?



Private Sub Form_Open(Cancel As Integer)
Call sEnableDrop(Me)
Call sHook(Me.Hwnd, "sDragDrop")
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call sUnhook(Me.Hwnd)
End Sub


Option Compare Database
Option Explicit
'************* 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))
MsgBox lngCount
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, _
strFunction As String)
'lpPrevWndProc = apiSetWindowLong(Hwnd, GWL_WNDPROC, AddrOf(strFunction))
Select Case strFunction
Case "sDragDrop"
lpPrevWndProc = apiSetWindowLong(Hwnd, GWL_WNDPROC, AddressOf sDragDrop)
Case Else
Debug.Assert False 'Need to setup this function as another Case.
End Select
End Sub

Sub sUnhook(Hwnd As Long)
Dim lngTmp As Long
lngTmp = apiSetWindowLong(Hwnd, _
GWL_WNDPROC, _
lpPrevWndProc)
lpPrevWndProc = 0
End Sub
'**************** Code End ***************
 
Old January 3rd, 2012, 12:44 PM
Friend of Wrox
 
Join Date: Sep 2010
Posts: 245
Thanks: 5
Thanked 24 Times in 23 Posts
Default

see reply to a duplicate of this post here: http://www.utteraccess.com/forum/Api...l#entry2194575
__________________
Boyd Trimmell aka HiTechCoach (.com)
Microsoft Access MVP Alumni 2010-2015





Similar Threads
Thread Thread Starter Forum Replies Last Post
Drag and drop davidkpham BOOK: Beginning JavaScript and CSS Development with jQuery 6 July 12th, 2009 03:10 AM
Drag and drop vpinhao Beginning VB 6 0 September 11th, 2006 01:33 PM
drag and drop to multiple text boxes gbuller VB.NET 5 September 6th, 2004 09:55 PM
Drag and drop Clive Astley Access 2 August 15th, 2003 12:11 PM
Search using drop down list box and a text box tcasp Classic ASP Basics 1 July 31st, 2003 02:58 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.