一份很有价值的子类化的源代码!

原创 2004年07月05日 15:11:00

' 新建一个 ActiveX DLL 工程,名称 SmartSubClassLib

' 以下代码放在标准模块里,模块名 mSmartSubClass

' ----------------------------------------------------
' Module mSmartSubClass
'
' Version... 1.0
' Date...... 24 April 2001
'
' Copyright (C) 2001 Andr閟 Pons (andres@vbsmart.com)
' ----------------------------------------------------

'API declarations:
Option Explicit

Public Const SSC_OLDPROC = "SSC_OLDPROC"
Public Const SSC_OBJADDR = "SSC_OBJADDR"

Private Declare Function GetProp Lib "user32" Alias "GetPropA" ( _
    ByVal hWnd As Long, _
    ByVal lpString As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

'
' Function StartSubclassWindowProc()
'
' This is the first windowproc that receives messages
' for all subclassed windows.
' The aim of this function is to just collect the message
' and deliver it to the right SmartSubClass instance.
'
Public Function SmartSubClassWindowProc( _
    ByVal hWnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

    Dim lRet As Long
    Dim oSmartSubClass As SmartSubClass

    'Get the memory address of the class instance...
    lRet = GetProp(hWnd, SSC_OBJADDR)
    
    If lRet <> 0 Then
        'oSmartSubClass will point to the class instance
        'without incrementing the class reference counter...
        CopyMemory oSmartSubClass, lRet, 4
        
        'Send the message to the class instance...
        SmartSubClassWindowProc = oSmartSubClass.WindowProc(hWnd, _
            uMsg, wParam, lParam)

        'Remove the address from memory...
        CopyMemory oSmartSubClass, 0&, 4
    End If
    
End Function

 

' 以下代码放在类模块里,模块名 SmartSubClass

' ----------------------------------------------------
' Class SmartSubClass
'
' Version... 1.0
' Date...... 24 April 2001
'
' Copyright (C) 2001 Andr閟 Pons (andres@vbsmart.com)
' ----------------------------------------------------

Option Explicit

'Public event:
Public Event NewMessage( _
    ByVal hWnd As Long, _
    ByRef uMsg As Long, _
    ByRef wParam As Long, _
    ByRef lParam As Long, _
    ByRef Cancel As Boolean)

'Private variables:
Private m_hWnds() As Long

'API declarations:
Private Const GWL_WNDPROC = (-4)

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) 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 Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

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 IsWindow Lib "user32" ( _
    ByVal hWnd As Long) As Long

'
' Function SubClassHwnd
'
' This is the core function in this class.
' You can use it to both subclass and unsubclass a window.
' Once a window is subclassed the event NewMessage will
' be raised every time a message is sent to the window.
'
Public Function SubClassHwnd(ByVal hWnd As Long, _
    ByVal bSubClass As Boolean) As Boolean

    Dim lRet As Long
    
    lRet = 0
    
    'Make sure that hWnd is a valid window handler...
    If IsWindow(hWnd) Then
    
        If bSubClass Then
        'We are subclassing a window...
            
            'Make sure that the window wasn't already subclassed...
            If GetProp(hWnd, SSC_OLDPROC) = 0 Then
            
                'Now we subclass the window by changing its windowproc
                lRet = SetWindowLong(hWnd, GWL_WNDPROC, _
                     AddressOf SmartSubClassWindowProc)
                
                'Check if we've managed to subclass...
                If lRet <> 0 Then
                    'Store the old windowproc and the memory
                    ' address of this class...
                    SetProp hWnd, SSC_OLDPROC, lRet
                    SetProp hWnd, SSC_OBJADDR, ObjPtr(Me)
                    
                    'Add the window to an internal list of
                    ' subclassed windows...
                    pAddHwndToList hWnd
                End If
            End If
        Else
        'We are unsubclassing a window...
        
            'Get the old windowproc...
            lRet = GetProp(hWnd, SSC_OLDPROC)
            
            If lRet <> 0 Then
                'Unsubclass the window...
                lRet = SetWindowLong(hWnd, GWL_WNDPROC, lRet)
            End If
            
            'Remove any extra information...
            RemoveProp hWnd, SSC_OLDPROC
            RemoveProp hWnd, SSC_OBJADDR
            
            'Remove the window from the internal list...
            pRemoveHwndFromList hWnd
        End If
    Else
        'If hWnd is not a valid window,
        'make sure that there isn't stored garbage...
        RemoveProp hWnd, SSC_OLDPROC
        RemoveProp hWnd, SSC_OBJADDR
        
        pRemoveHwndFromList hWnd
    End If
      
    SubClassHwnd = (lRet <> 0)
    
End Function

'
' Function WindowProc
'
' This is the link between the windowproc and the class instance.
' Every time SmartSubClassWindowProc receives a window message,
' it will post it to the right class instance.
'
Friend Function WindowProc( _
    ByVal hWnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

    Dim lRet As Long
    Dim bCancel As Boolean
    
    bCancel = False
    
    WindowProc = 0
    
    'Raise the event NewMessage...
    'This will tell the owner of the class variable that a
    'new message is ready to be processed.
    'The owner will be able to cancel the message by setting
    'the variable bCancel to True.
    RaiseEvent NewMessage(hWnd, uMsg, wParam, lParam, bCancel)
    
    'If the event hasn't been canceled by the owner
    'we need to send it to the original windowproc
    If Not bCancel Then
    
        lRet = GetProp(hWnd, SSC_OLDPROC)
        
        If lRet <> 0 Then
            'Send the message to the original windowproc...
            WindowProc = CallWindowProc(lRet, hWnd, uMsg, wParam, lParam)
        End If
        
    End If
    
End Function

'
' Every instance of the class mantains an internal
' list of subclassed windows.
'
Private Sub Class_Initialize()
    ReDim m_hWnds(0) As Long
End Sub

'
' When the class terminates it makes sure that
' there are no remainig subclassed windows.
'
Private Sub Class_Terminate()
    Dim i As Long
    For i = UBound(m_hWnds) To 1 Step -1
        If m_hWnds(i) > 0 Then
            SubClassHwnd m_hWnds(i), False
        End If
    Next i
End Sub

'
' Private Function pFindHwndInList()
'
' This functions searches for a specific window
' in its internal list. If it doesn't find the
' window it returns 0.
'
Private Function pFindHwndInList(ByVal hWnd As Long) As Long
    Dim i As Long
    Dim lPos As Long
    lPos = 0
    For i = 1 To UBound(m_hWnds)
        If m_hWnds(i) = hWnd And m_hWnds(i) > 0 Then
            lPos = i
            Exit For
        End If
    Next i
    pFindHwndInList = lPos
End Function

'
' Private Sub pAddHwndToList()
'
' This procedure adds a window handle to the internal list...
'
Private Sub pAddHwndToList(ByVal hWnd As Long)
    Dim lPos As Long
    If pFindHwndInList(hWnd) = 0 Then
        lPos = pFindNextPositionAvailableInList
        If lPos <> 0 Then
            m_hWnds(lPos) = hWnd
        Else
            lPos = UBound(m_hWnds) + 1
            ReDim Preserve m_hWnds(lPos) As Long
            
            m_hWnds(lPos) = hWnd
        End If
    End If
End Sub

'
' Private Sub pRemoveHwndFromList()
'
' This procedure removes a window handle from the internal list...
'
Private Sub pRemoveHwndFromList(ByVal hWnd As Long)
    Dim lPos As Long
    lPos = pFindHwndInList(hWnd)
    If lPos <> 0 Then
        If lPos = UBound(m_hWnds) Then
            ReDim Preserve m_hWnds(lPos - 1) As Long
        Else
            m_hWnds(lPos) = -1
        End If
    End If
End Sub

'
' Private Function pFindNextPositionAvailableInList()
'
' This functions searches for an "empty" entry in the
' internal list of window handles. When an entry is
' removed its is marked as empty by setting its value to -1.
'
' If there are no positions available, the function returns 0.
'
Private Function pFindNextPositionAvailableInList() As Long
    Dim i As Long
    Dim lPos As Long
    lPos = 0
    For i = 1 To UBound(m_hWnds)
        If m_hWnds(i) <= 0 Then
            lPos = i
            Exit For
        End If
    Next i
    pFindNextPositionAvailableInList = lPos
End Function

MFC子类化控件

转自:代码小卒的文章MFC子类化控件子类化理解作为一个程序员,我们经常会在程序中用到Windows通用控件。比如按钮控件,进度条控件等等。但是有时我们需要给控件更多的特色,这就需要做控件的子类化(su...
  • xuanyuanlei1020
  • xuanyuanlei1020
  • 2016年10月31日 11:59
  • 756

超类化与子类化的区别?

本文转自:http://hi.baidu.com/zish/blog/item/2a4098501bef706a853524ca.html 1.子类化:改变一个已经存在的窗口实例的性质:消息处理与其他...
  • FlowShell
  • FlowShell
  • 2009年12月10日 20:59
  • 3132

Qt学习笔记外观篇(五):子类化窗口部件类

如前所述,自定义
  • wangyanphp
  • wangyanphp
  • 2014年08月27日 10:02
  • 2121

Windows下子类化目标窗口的方法

当需要干预目标程序的某些操作的时候,除了以前提到的Hook,还可以使用“子类化”目标窗口的方法。先假设一种场合:当需干预目标程序的窗口的某个Panel上的点击事件(类似的也可以)的时候,如果使用HOO...
  • sunshinwong
  • sunshinwong
  • 2015年01月23日 16:15
  • 757

Win32的窗口子类化

也许你需要一个特殊的Edit来限制浮点数的输入,但是现有的Edit却并不能完成这项工作――因为它只能够单纯的限制大小写或者纯数字。当你在论坛上求救的时候,某个网友告诉你:“用子类化。”你也许会在看到一...
  • chaos_epimetheus
  • chaos_epimetheus
  • 2012年09月05日 14:32
  • 656

[学习笔记]窗口子类化实例

窗口子类化实例:点击一个按钮,在按钮本身的消息(按钮的消息回调函数)中弹出对话框,而不是在COMMAND(父类的消息回调函数)消息中弹出对话框。...
  • cyxvc
  • cyxvc
  • 2015年10月02日 18:43
  • 452

控件子类化

当程序使用你自已所实现的派生控件子类时,主窗口的消息是无法到达你的子类函数的.这时,你有两个方法:1.       使用DDX_Contrl(pDX,IDC_BUTTON,mMyButton)把你的子...
  • sjcode
  • sjcode
  • 2007年09月07日 19:02
  • 1084

第二章 创建对话框 2.1子类化QDialog(1)

对话框可以为用户和应用程序之间提供一种可以相互的江湖
  • y519476132
  • y519476132
  • 2014年04月10日 23:48
  • 491

第二章 创建对话框 2.1子类化QDialog(2)

现在来看类的源文件 发inddia
  • y519476132
  • y519476132
  • 2014年04月11日 01:03
  • 489

qt学习第四课:子类化窗口

在本节课中,学习了如何子类化一个窗口,在下面就以经常用到的查找对话框为例: 具体的运行结果如下: 这个对话框就是一个基于QDialog的子类。 具体代码如下: #ifndef ...
  • u011619422
  • u011619422
  • 2015年08月01日 15:38
  • 961
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:一份很有价值的子类化的源代码!
举报原因:
原因补充:

(最多只允许输入30个字)