無崩潰（VB IDE）子類技術實作

        但是如果簡單的用幾個API來實作子類，那麼隻要你非正常關閉窗體或者加入中斷點調試，不好意思，VB IDE崩潰，所有的一切都要重來。

       有沒有無崩潰的子類技術呢？我這裡目前不光有一種，還有兩種：）

       第二種，其實這是我看 HookMenu源碼的心得，是高手的結晶，這裡不敢奪愛。HookMenu作者高就高在，用彙編代碼實作了視窗消息處理函數，然後編譯成二進制碼，由VB程式進行調用，這樣僅需要在程式中添加一個類（外引用一個該類的接口檔案SubclassingSink.tlb），就可以很綠色，并且無崩潰的實作了子類化，由于作者原代碼包含内容較多，是以我簡化了一下，自己重新封裝了一個類，然後又做了一個示例。這樣讓高端技術平民化，讓每一個VB愛好者都會使用。

     示例代碼如下：

  '*************************************************************************

'**模 塊 名：frmDemo

'**說    明：Sky Walker(天行者) 版權所有2006 - 2007(C)

'**創 建 人：葉帆

'**日    期：2006-01-02 17:29:24

'**修 改 人：

'**日    期：

'**描    述：視窗子類化示例（無崩潰）

'**版    本：V1.0.0

'*************************************************************************

Option Explicit

Implements ISubclassingSink         '接口定義 需引用接口檔案SubclassingSink.tlb

Private mSubclass As CSubclass      '實作類

Private Const WM_SIZE = &H5

Private Const WM_MOUSEWHEEL = &H20A

Private Const WM_LBUTTONDOWN = &H201

Private Const WM_LBUTTONUP = &H202

Private Const WM_LBUTTONDBLCLK = &H203

Private Const WM_RBUTTONDOWN = &H204

Private Const WM_RBUTTONUP = &H205

'**函 數 名：Form_Load

'**輸    入：無

'**輸    出：無

'**功能描述：初始化子類

'**全局變量：

'**調用子產品：

'**作    者：葉帆

'**日    期：2006-01-02 17:33:02

Private Sub Form_Load()

    Set mSubclass = New CSubclass    '初始化一個子類

    '添加消息 (前截獲)

    mSubclass.AddBeforeMsgs WM_MOUSEWHEEL, WM_SIZE, WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK

    '添加消息 (後截獲)

    mSubclass.AddAfterMsgs WM_MOUSEWHEEL, WM_RBUTTONDOWN, WM_RBUTTONUP

    '擷取全部的消息

    'mSubclass.AllAfterMsgs = True

    'mSubclass.AllBeforeMsgs = True

    '添加子類

    mSubclass.Subclass hWnd, Me

End Sub

'**函 數 名：Form_Unload

'**輸    入：Cancel(Integer) -

'**功能描述：解除安裝子類

'**日    期：2006-01-02 17:35:16

Private Sub Form_Unload(Cancel As Integer)

    mSubclass.UnSubclass

'**函 數 名：ISubclassingSink_After

'**輸    入：lReturn(Long)      -

'**        ：ByVal hwnd(Long)   -

'**        ：ByVal uMsg(Long)   -

'**        ：ByVal wParam(Long) -

'**        ：ByVal lParam(Long) -

'**功能描述：

'**日    期：2006-01-02 17:36:40

Private Sub ISubclassingSink_After(lReturn As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

    Debug.Print "ISubclassingSink_After " & " - " & Hex(uMsg) & " - " & Timer

'**函 數 名：ISubclassingSink_Before

'**輸    入：bHandled(Boolean) -

'**        ：lReturn(Long)     -

'**        ：hwnd(Long)        -

'**        ：uMsg(Long)        -

'**        ：wParam(Long)      -

'**        ：lParam(Long)      -

'**日    期：2006-01-02 17:36:41

Private Sub ISubclassingSink_Before(bHandled As Boolean, lReturn As Long, hWnd As Long, uMsg As Long, wParam As Long, lParam As Long)

    Debug.Print "ISubclassingSink_Before " & " - " & Hex(uMsg) & " - " & Timer

    'bHandled = True   'ISubclassingSink_After消息不在觸發,并且該消息不向原窗體下發

    'lReturn=mSubclass.CallOrigWndProc(uMsg, wParam, lParam)   '向原窗體發送消息

類的代碼就不在列舉了，請大家看源碼