支援任意表單、控制項、組件的檔案拖動類（VB.Net源碼）

檔案拖拽可以通過控制項的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