VB子类化时容易忽略的重要的消息:WM_NCDESTROY

'*************************************************************************
'**说      明：丹心软件在线设计 版权所有2007 - 2008(C)
'**创 建 人：丹心
'**日      期：2007-09-16 22:26:36
'**修 改 人：
'**日      期：
'**描      述：安全的子类化卸载例子
'**版      本：V1.0.0
'**博客地址：http://hi.baidu.com/starwork/
'**QQ    号码：121877114
'**E - mail:cnstarwork@126.com
'*************************************************************************

'      VB子类化的方式很容易造成VB IDE的崩溃。不要在调试模式中途暂停或终于应用程序，
'因为这样可能不能恢复源窗口过程函数，造成无法处理正常的消息，变得异常或IDE崩溃，
'因此切记调试前一定存盘
'      那如何处理子类化在VB IDE环境的中断呢?因为我们卸载一个窗口对象，系统会发送
'WM_NCDESTROY (在按下VB IDE的停止按钮也会产生该消息) 消息给对象，因此我们可以通过检测这个消息来自动恢复对象的源窗口过程。
'下面的是例子是一个简单的安全的子类化卸载例子


'主窗体FORM1的代码

Option Explicit

Private Sub Form_Load()
      If SubClass(hWnd) Then
          If IsIDE Then
              MsgBox "本窗口为子类化窗体.不要用VB的结束按钮或" & vbCrLf & _
                      "结束菜单命令\或关闭VB来关闭它,只能通过它自" & vbCrLf & _
                      "己的系统菜单关闭它." & vbCrLf & vbCrLf
          End If
      End If
End Sub
  
Private Function IsIDE() As Boolean
On Error GoTo Out
     Debug.Print 1 / 0
     IsIDE = False
     Exit Function
Out:
      IsIDE = True
End Function
  
Private Sub Form_Unload(Cancel As Integer)
      Call UnSubClass(hWnd)
End Sub




'模块代码:


Option Explicit

Private Const GWL_WNDPROC = (-4)
Private Const WM_NCDESTROY = &H82 ' 组件被销毁时的消息,在按下VB IDE的停止按钮也会产生
Private Const OLDWNDPROC = "OldWndProc"
  
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
'子类化开始
Public Function SubClass(hWnd As Long) As Boolean
      Dim lpfnOld       As Long
      Dim fSuccess       As Boolean
      
      If (GetProp(hWnd, OLDWNDPROC) = 0) Then
          lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
          If lpfnOld Then
              fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)
          End If
      End If
      
      If fSuccess Then
          SubClass = True
      Else
          If lpfnOld Then Call UnSubClass(hWnd)
      End If
      
End Function

'卸载子类化
Public Function UnSubClass(hWnd As Long) As Boolean
      Dim lpfnOld       As Long
      lpfnOld = GetProp(hWnd, OLDWNDPROC)
      If lpfnOld Then
          If RemoveProp(hWnd, OLDWNDPROC) Then
              UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)
          End If
      End If
End Function
  
Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
      Select Case uMsg
          Case WM_NCDESTROY ' 如果收到组件被销毁的消息，恢复源窗口过程处理函数
              Call UnSubClass(hWnd)
              MsgBox "卸载子类化    &H" & Hex(hWnd), vbCritical, "警告"
      End Select
      
      WndProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
End Function