现在的位置: 首页 > 综合 > 正文

支持任意窗体、控件、组件的文件拖动类(VB.Net源码)

2011年08月27日 ⁄ 综合 ⁄ 共 7204字 ⁄ 字号 评论关闭

文件拖拽可以通过控件的drag属性进行设置,然后响应它的drag事件进行,但是有些控件并不支持文件拖拽

有鉴于此,本文中写的是一个实现任意窗体、控件、组件响应文件拖拽的类,用法也很简单

以Form为例,首先定义一个全局变量

Private pDrag As DragDropFiles

然后在form的load事件中

pDrag.DragDropHwnd = Me.Handle
pDrag.DragDropLoad()

此时就可以向form中拖入文件

pDrag.DragDropFiles即为拖入文件的文件路径集合,可以对拖入文件进行操作了

在Form的close事件中

pDrag.DragDropUnLoad()

 

类源代码如下:

Imports System.Runtime.InteropServices

''' <summary>
''' 本例是采用子类派生技术实现的文件从EXPLORE到VB程序的拖放    通过三个API函数DragAcceptFiles、DragQueryFiles和DragFinish并通过回调函数WindowProc,窗口属性函数SetWindowLong、CallWindowProc的使用实现。
''' </summary>
''' <remarks></remarks>

Public Class DragDropFiles

#Region "与外部交互"
  Private m_DragDropFiles As New List(Of String)
  ''' <summary>
  ''' 托拽的文件路径list
  ''' </summary>
  ''' <value></value>
  ''' <returns></returns>
  ''' <remarks></remarks>
  ReadOnly Property DragDropFiles() As List(Of String)
    Get
      Return m_DragDropFiles
    End Get
  End Property
  Private m_Hwnd As Integer
  ''' <summary>
  ''' 当前需要接受文件拖动的控件的句柄
  ''' </summary>
  ''' <value></value>
  ''' <remarks></remarks>
  WriteOnly Property DragDropHwnd() As Integer
    Set(ByVal value As Integer)
      m_Hwnd = value
    End Set
  End Property
  ''' <summary>
  ''' 加载Dragdrop
  ''' </summary>
  ''' <remarks></remarks>
  Overridable Sub DragDropLoad()
    '定义 frmDragDropFiles窗体作为接收文件拖放的容器
    'DragAcceptFiles Me.hwnd, 1&
    DragAcceptFiles(m_Hwnd, 1&)
    '整个procOld变量用来存储窗口的原始参数,以便恢复
    ' 调用了 SetWindowLong 函数,它使用了 GWL_WNDPROC 索引来创建窗口类的子类,通过这样设置
    '操作系统发给窗体的消息将由回调函数 (WindowProc) 来截取, AddressOf是关键字取得函数地址
    Dim mysub As New DelegateWindowProc(AddressOf WindowProc)
    GCHandle.Alloc(mysub) ''为委托建立句柄,以免它被垃圾回收,导致出错
    '第二种避免垃圾回收的办法
    'GC.Collect()
    'GC.WaitForPendingFinalizers()
    'GC.Collect()
    procOld = SetWindowLong(m_Hwnd, GWL_WNDPROC, mysub)
    'procOld = SetWindowLong(m_Hwnd, GWL_WNDPROC, AddressOf WindowProc)
    'AddressOf是一元运算符,它在过程地址传送到 API 过程之前,先得到该过程的地址
  End Sub
  ''' <summary>
  ''' 卸载dragdrop
  ''' </summary>
  ''' <remarks></remarks>
  Sub DragDropUnLoad()
    '此句关键,把窗口(不是窗体,而是具有句柄的任一控件,这里指Picture1)的属性复原
    SetWindowLong(m_Hwnd, GWL_WNDPROC, procOld)
  End Sub
  ''' <summary>
  ''' 解析字符串,将全路径解析获得路径和文件名
  ''' </summary>
  ''' <param name="pFilePath">全路径</param>
  ''' <param name="pPath">路径</param>
  ''' <param name="pName">文件名</param>
  ''' <remarks></remarks>
  Sub DragDropStringParse(ByVal pFilePath As String, ByRef pPath As String, ByRef pName As String)
    Dim i As Integer = pFilePath.LastIndexOf("\")
    pPath = pFilePath.Substring(0, i)
    pName = pFilePath.Substring(i + 1)
  End Sub
#End Region

#Region "拖放操作相关的API函数"
  Private Const MAX_PATH As Long = 260&
  '标示我们要截获的消息
  Private Const WM_DROPFILES As Long = &H233&
  '保存原 窗体属性的变量,其实是默认的 窗体函数 的地址
  Private procOld As Integer
  Private Const GWL_WNDPROC As Long = (-4&)
  Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Integer, ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
  Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd As Int32, ByVal fAccept As Int32)
  Private Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Int32)
  Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Int32, ByVal UINT As Int32, ByVal lpStr As String, ByVal ch As Int32) As Int32
  ''' <summary>
  ''' 在窗口结构中为指定的窗口设置信息
  ''' </summary>
  ''' <param name="hwnd">欲为其取得信息的窗口的句柄</param>
  ''' <param name="nIndex">请参考GetWindowLong函数的nIndex参数的说明</param>
  ''' <param name="dwNewLong">由nIndex指定的窗口信息的新值</param>
  ''' <returns>指定数据的前一个值</returns>
  ''' <remarks></remarks>
  Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As DelegateWindowProc) As Integer
  ''' <summary>
  ''' 在窗口结构中为指定的窗口设置信息
  ''' </summary>
  ''' <param name="hwnd">欲为其取得信息的窗口的句柄</param>
  ''' <param name="nIndex">请参考GetWindowLong函数的nIndex参数的说明</param>
  ''' <param name="dwNewLong">由nIndex指定的窗口信息的新值</param>
  ''' <returns>指定数据的前一个值</returns>
  ''' <remarks></remarks>
  Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
#End Region

#Region "核心处理函数"
  ''' <summary>
  ''' 委托
  ''' </summary>
  ''' <param name="wParam"></param>
  ''' <param name="lParam"></param>
  ''' <returns></returns>
  ''' <remarks> WARNING!!!!-----------------------------------------------------------'注意这段代码是不能用DEBUG一步步调试的,否则会造成错误(崩溃)  '对消息截获的机制可以按下述理解:    这里要仔细理解一下,我们为窗体新指定了窗体函数地址,也就是说操作系统发送给窗体的  '消息将被 WindowProc函数 所截获(而改变前消息是被默认的 窗体函数 所获得并作相应处理的)    这样我们在 WindowProc函数 中对所截获的消息进行判断,会有三种情况:(1)如果是需要通过程序来处理的消息就通过 WindowProc函数 中的相应语句处理;(2)如果是要原来的 窗体函数 来处理则把这个消息传递给原窗体函数(其实是指针指向的改变);(3)如果不是我们需要的消息,也传递给原 窗体函数 来处理。可以参见 改变系统菜单 中的源码注释WARNING!!!!-----------------------------------------------------------</remarks>
  Private Delegate Function DelegateWindowProc(ByVal hwnd As Integer, ByVal iMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
  ''' <summary>
  ''' 回调函数,用来截取消息
  ''' </summary>
  ''' <param name="hwnd"></param>
  ''' <param name="iMsg"></param>
  ''' <param name="wParam"></param>
  ''' <param name="lParam"></param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Private Function WindowProc(ByVal hwnd As Integer, ByVal iMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    '确定接收到的是什么消息
    Select Case iMsg
      '如果是 通知文件放下 的消息,就拦截消息
      Case WM_DROPFILES
        '通知在FORM模块中定义的DropFiles函数来接收 指向 放下的文件 的句柄
        DropFiles(wParam)
        '返回0并退出这个WindowProc
        Return 0
        Exit Function
    End Select
    '如果不是我们需要的消息,则传递给原来的窗体函数处理
    Return CallWindowProc(procOld, hwnd, iMsg, wParam, lParam)
  End Function

  ''' <summary>
  ''' 放置文件,得到文件
  ''' </summary>
  ''' <param name="hDrop"></param>
  ''' <remarks></remarks>
  Protected Overridable Sub DropFiles(ByVal hDrop&)
    Dim sFileName As String, IReturn As Integer
    Dim nCount, I As Integer
    '为sFileName分配存储空间
    sFileName = Space(MAX_PATH)
    '通过文件指针hDrop, DragQueryFile返回是否有文件拖放,nCount返回拖放文件的个数
    nCount = DragQueryFile(hDrop, -1, sFileName, MAX_PATH)
    '循环读取每一个拖放的文件,把它在列表框中显示出来
    For I = 0 To nCount - 1
      sFileName = Space(MAX_PATH)
      '如果有文件拖放,接收文件名,并试图把它在图片框中打开
      'IReturn&
      IReturn = DragQueryFile(hDrop, I, sFileName, MAX_PATH)
      m_DragDropFiles.Clear()
      m_DragDropFiles.Add(sFileName.Substring(0, IReturn))
    Next I
    '完成拖放操作
    DragFinish(hDrop)
  End Sub

#End Region

#Region "相关技术说明"
  '---------------------相关内容-----------------------
  '什么是子类派生技术
  '    WINDOWS运行的基础是“消息机制”,所谓的“消息”是一个唯一的值,这个值会被一个窗体或操作系统
  '收到,它能告诉什么事件发生了以及需要采用什么样的动作来响应。这与我们人类的神经系统将感知的信
  '息传递给大脑,而大脑发出指令给我们的身体非常相似。
  '    于是每一个窗体都具有一个消息句柄,这个机制使得所有发自于WINDOWS操作系统的消息能被接收到
  '需要强调的是每个窗体以及每个控件,包括按钮、文本框、图片框等都具有这样的消息句柄。WINDOWS操
  '作系统会跟踪这些消息句柄,这称为类结构中的一个WindowProc,所谓的类结构是于窗体句柄相关联的。
  '    当我们加入一个新的WindowProc函数而这个WindowProc与原始的窗体函数相符合的话,我们称这个窗
  '被子类化了。换言之,如果WINDOWS操作系统发给你所在的WindowProc一个消息,而你所在的WindowProc
  '正在响应其它的动作,这时你必须将剩余的消息传递给一个默认的WindoProc。
  '如下所示: 操作系统消息-->你所在WindoProc-->默认的WindoProc
  '而一个窗体是可以被子类化多次的,这样就产生了如下的情况:
  'Windows Message Sender --> Your WindowProc --> Another WindowProc _
  '  --> Yet Another WindowProc --> Default WindowProc
  ' What is subclassing anyway?
  '    通过窗体子类化,你可以改变响应消息的顺序,也就是说,你可以把消息传递到默认的WindowProc上
  '而不立即响应。举个例子:
  '    如果我们要在接收到WM_PAINT 消息后,在窗体上画出一些东西,可以用下面的语句实现:
  '
  ' Public Function WindowProc(Byval hWnd, Byval etc....)
  '
  '   Select Case iMsg          '筛选出WM_PAINT消息
  '     Case SOME_MESSAGE       '如果是其他消息
  '       DoSomeStuff
  '
  '     Case WM_PAINT           '如果是WM_PAINT 消息
  '       '首先把消息传递给一个默认的WindowProc
  '       WindowProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
  '
  '       DoDrawingStuff        '进行画图操作
  '
  '       Exit Function         '因为我们已经把消息传递给默认的WindowProc,我们可以退出这个WindowProc
  '
  '   End Select
  '
  ' End Function
  '------------------------------------------------------
#End Region

抱歉!评论已关闭.