Tweet
Code:
'________________________________________________________________________________________
'
' Drag/Drop functions
' -------------------
'
' Simple demonstration of how to accept "dragged" files on your window of choice.
' [b]NEW: Now also allows for right-click "pasting" of files.[/b]
'
' By Kevin G. Peel, KGP Software. 2003. Posted: July 2006.
' [url="http://www.kgpsoftware.com."]http://www.kgpsoftware.com.[/url]
'________________________________________________________________________________________
#Compile Exe
#Dim All
#Register All
$APPTITLE = "DragDrop Example"
%USEMACROS = 1
#Include "win32api.inc"
Declare Function Sub1(p1 As Any) As Dword
Declare Function Sub2(p1 As Any, p2 As Any) As Dword
Declare Function Sub3(p1 As Any, p2 As Any, p3 As Any) As Dword
Declare Function Sub5(p1 As Any, p2 As Any, p3 As Any, p4 As Any, p5 As Any) As Dword
'------------------------------------------------------------------------------
' Returns details from a link (LNK) file, based on iType.
' 1 = link file name, 2 = link path name, 3 = link parameters
'
' Note: parts of the following function were found on PB forum,
' so credit goes to the original authors.
'------------------------------------------------------------------------------
Function GetLinkInfo(ByVal sLinkPath As String, ByVal nType As Long) As String
Local CLSCTX_INPROC_SERVER As Dword, CLSID_ShellLink As GUIDAPI
Local FileData As WIN32_FIND_DATA, Flags As Dword
Local IID_IShellLink As GUIDAPI, IID_Persist As String * 16
Local lResult As Dword, outvalue As Asciiz * %MAX_PATH, nRet As Long
Local pp As Dword Ptr, ppf As Dword Ptr, psl As Dword Ptr
Local TmpAsciiz As Asciiz * %MAX_PATH, TmpWide As Asciiz * (%MAX_PATH*2)
Poke$ VarPtr(CLSID_ShellLink), Mkl$(&H00021401) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
Poke$ VarPtr(IID_IShellLink), Mkl$(&H000214EE) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
IID_Persist = Mkl$(&H0000010B) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
CLSCTX_INPROC_SERVER = 1
nRet = CoCreateInstance(CLSID_ShellLink, ByVal %NULL, CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
If (nRet = %S_OK) Then
pp = @psl
Call Dword @pp Using Sub3(ByVal psl, IID_Persist, ppf) To lResult
TmpAsciiz = sLinkPath
MultiByteToWideChar %CP_ACP, 0, TmpAsciiz, -1, ByVal VarPtr(TmpWide), %MAX_PATH
pp = @ppf + 20
Call Dword @pp Using Sub3(ByVal ppf, TmpWide, ByVal %True)
Select Case nType
Case 2
pp = @psl + 32
Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
Case 3
pp = @psl + 40
Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
Case Else
pp = @psl + 12
Call Dword @pp Using Sub5(ByVal psl, outvalue, ByVal %MAX_PATH, FileData, Flags)
End Select
' Release the persistant file
pp = @ppf + 8
Call Dword @pp Using Sub1(ByVal ppf)
' Unbind the shell link object from the persistent file
pp = @psl + 8
Call Dword @pp Using Sub1(ByVal psl)
Function = outValue
End If
End Function
'------------------------------------------------------------------------------
' Return a list of drag/drop filenames, separated by | (See WM_DROPFILES message)
' Note: this function also finishes the specified drag/drop operation.
'------------------------------------------------------------------------------
Function GetDropFiles(ByVal hDropParam As Dword) As String
Local sDropFiles As String, sText As String, i As Long
For i = 0 To DragQueryFile(hDropParam, &HFFFFFFFF&, "", 0)-1
sText = Space$(DragQueryFile(hDropParam, i, "", 0)+1)
DragQueryFile hDropParam, i, ByVal StrPtr(sText), Len(sText)
sText = Left$(sText, Len(sText)-1)
If UCase$(Right$(sText, 4)) = ".LNK" Then sText = GetLinkInfo(sText, 1)
sDropFiles = sDropFiles + sText + "|"
Next i
DragFinish hDropParam
Function = RTrim$(sDropFiles, "|")
End Function
'------------------------------------------------------------------------------
' Callback prcoedure for main dialog.
'------------------------------------------------------------------------------
CallBack Function dlgDropExample
Local sFiles As String, pDrop As Dword
Select Case CbMsg
Case %WM_DROPFILES
' Test for files "dragged" onto window...
pDrop = CbWParam
sFiles = GetDropFiles(pDrop)
If Len(sFiles) Then
' Display list of files "dropped"...
Replace "|" With $CrLf In sFiles
MessageBox CbHndl, "Files dropped onto the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_ICONINFORMATION
End If
Case %WM_RBUTTONUP
' Test for files on clipboard (paste-like operation)...
OpenClipBoard 0
pDrop = GetClipboardData(%CF_HDROP)
sFiles = GetDropFiles(pDrop)
CloseClipboard
If Len(sFiles) Then
' Display list of files "dropped"...
Replace "|" With $CrLf In sFiles
MessageBox CbHndl, "Files pasted into the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_ICONINFORMATION
End If
End Select
End Function
'------------------------------------------------------------------------------
' Program Start Point
'------------------------------------------------------------------------------
Function PBMain
Local hDlg As Dword
Dialog New %HWND_DESKTOP, $APPTITLE, , , 250, 150, %WS_OVERLAPPEDWINDOW To hDlg
Control Add Label, hDlg, 100, "Drag a file onto this dialog from explorer or right click with some copied files to display them...", 10, 10, 150, 35
DragAcceptFiles hDlg, %TRUE
Dialog Show Modal hDlg Call dlgDropExample
End Function
contact page
kgpsoftware.com - Home of the Slam Database Manager..
[This message has been edited by Kev Peel (edited July 27, 2006).]
Comment