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