最新下载
热门教程
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
一份很有价值的子类化的源代码!
时间:2022-07-02 18:09:30 编辑:袖梨 来源:一聚教程网
' 新建一个 ActiveX DLL 工程,名称 SmartSubClassLib
' 以下代码放在标准模块里,模块名 mSmartSubClass
' ----------------------------------------------------
' Module mSmartSubClass
'
' Version... 1.0
' Date...... 24 April 2001
'
' Copyright (C) 2001 Andr轶 Pons ([email protected])
' ----------------------------------------------------
'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 ([email protected])
' ----------------------------------------------------
'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)
相关文章
- 云星穹铁道权益升级怎么玩 云崩铁权益升级活动介绍 12-03
- 以闪亮之名山中绘梦怎么玩 以闪亮之名滢然花梦套装活动介绍 12-03
- 以闪亮之名绿野梦歌礼包怎么样 以闪亮之名绿野梦歌拍照礼包介绍 12-03
- 光遇12.6有什么更新 光遇12月6日更新内容介绍 12-03
- 伍六七暗影交锋测试资格怎么获得 伍六七暗影交锋内测资格获取方法 12-03
- 无限暖暖晶莹诗集怎么样 12-03