最新下载
热门教程
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
一份很有价值的子类化的源代码!
时间:2008-01-12 编辑:简简单单 来源:一聚教程网
' 新建一个 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)
' 以下代码放在标准模块里,模块名 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)
相关文章
- SpringBoot测试配置属性与web启动环境解析 10-24
- vue中将el-switch值true、false改为number类型的1和0解析 10-24
- Vue中的路由配置项meta使用解读 10-24
- SpringBoot自定义bean绑定解析 10-24
- SpringBoot常用计量与bean属性校验和进制数据转换规则解析 10-24
- 工厂方法在Spring框架中的运用介绍 10-24