WIN-API方法向表单拖放文件,文件路径及名称显示到列表框中

出处：http://www.news2news.com/vfp/?function=-1&example=323
环境支持：VFP9.0
从Windows拖拽文件到表单,文件路径及名称将自动添加到列表框中



Local oForm As TForm
oForm=Createobject("TForm")
oForm.Visible=.T.
Read Events
* end of main
Define Class TForm As Form
#Define WM_DROPFILES 0x0233
#Define GWL_WNDPROC -4
#Define MAX_PATH 260
Protected hWindow,hOrigProc
hWindow=0
hOrigProc=0
Width=500
Height=200
MinButton=.F.
MaxButton=.F.
Caption="向表单拖放文件 (环境支持：VFP9.0)" &&Dropping files on the form
ShowWindow=2
AutoCenter=.T.
Add Object ch As Checkbox With Left=10,Top=10,AutoSize=.T.,BackStyle=0,Caption="允许拖放文件",Value=0 &&Accept dropped files
Add Object lst As ListBox With Left=5,Top=40,Width=490,Height=130
* Drag files from an Explorer window and drop on the listbox
Add Object lbl As Label With Left=10,Top=176,AutoSize=.T.,BackStyle=0,Caption="从Windows拖拽文件到表单,文件路径及名称将自动添加到列表框中."
Procedure Init
This.Declare
Endproc
Procedure Destroy
This.ReleaseAccept
Clear Events
Endproc
Procedure ch.InteractiveChange
If This.Value=1
Thisform.SetAccept
Else
Thisform.ReleaseAccept
Endif
Endproc
Procedure SetAccept
This.hWindow=GetFocus()
This.hOrigProc=GetWindowLong(This.hWindow,GWL_WNDPROC)
If Version(5)>=900
=Bindevent(This.hWindow,WM_DROPFILES,This,"OnFilesDropped")
Endif
=DragAcceptFiles(This.hWindow,1)
Endproc
Procedure ReleaseAccept
=Unbindevents(This)
If This.hWindow<>0
=DragAcceptFiles(This.hWindow,0)
This.hWindow=0
Endif
Endproc
Procedure OnFilesDropped(hWindow As Integer,nMsgID As Integer,wParam As Integer,Lparam As Integer)
* requires VFP9,otherwise ignored
* note that input parameters are predefined and should not be changed
* see WindowProc function for details
Local nReturn
nReturn=0
Do Case
Case nMsgID=WM_DROPFILES
This.ProcessDroppedFiles(wParam)
Otherwise
* pass control to the original window procedure
nReturn=CallWindowProc(This.hOrigProc,This.hWindow,m.nMsgID,m.wParam,m.lParam)
Endcase
Return nReturn
Endproc
Protected Procedure ProcessDroppedFiles(hDrop)
Local cPoint,nX,nY
cPoint=Replicate(Chr(0),8) && POINT buffer
=DragQueryPoint(hDrop,@cPoint)
nX=buf2dword(Substr(cPoint,1,4))
nY=buf2dword(Substr(cPoint,5,4))
* Only If clicked inside the ListBox
With This.lst
If Not (Between(nX,.Left,.Left+.Width-1) And Between(nY,.Top,.Top+.Height-1))
Return
=DragFinish(hDrop)
Endif
Endwith
This.lst.Clear
Local nFilecount,nIndex,cBuffer,nLength
nFilecount=DragQueryFile(hDrop,0xFFFFFFFF,Null,0)
For nIndex=0 To nFilecount-1
cBuffer=Replicate(Chr(0),MAX_PATH)
nLength=DragQueryFile(hDrop,nIndex,@cBuffer,MAX_PATH)
cBuffer=Substr(cBuffer,1,nLength)
This.lst.AddItem(cBuffer)
Next
=DragFinish(hDrop)
Endproc
Protected Procedure Declare
Declare Integer GetFocus In user32
Declare DragFinish In shell32 Integer hDrop
Declare DragAcceptFiles In Shell32 Integer hWindow,Integer fAccept
Declare Integer DragQueryFile In shell32 Integer hDrop,Integer iFile,String @lpszFile,Integer cch
Declare Integer DragQueryPoint In shell32 Integer hDrop,String @lppt
Declare Integer CallWindowProc In user32 Integer lpPrevWndFunc,Integer hWindow,Long Msg,Integer wParam,Integer Lparam
Declare Integer GetWindowLong In user32 Integer hWindow,Integer nIndex
Endproc
Enddefine
Function buf2dword(lcBuffer)
Return Asc(Substr(lcBuffer,1,1))+Bitlshift(Asc(Substr(lcBuffer,2,1)), 8)+Bitlshift(Asc(Substr(lcBuffer,3,1)),16)+Bitlshift(Asc(Substr(lcBuffer,4,1)),24)
Endfunc