最新下载
热门教程
- 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)
相关文章
- 明末渊虚之羽在哪里获取头陀的回响 头陀回响获取方法 07-30
- 2025年全球十大加密货币交易平台App排名 最新交易所榜单推荐 07-30
- 剑星战斗思路是什么 战斗思路分享 07-30
- Twinstake 推出 ETH 质押「启动与退出计算机」 07-30
- 燕云十六声寄棺主无伤怎么通关 鬼神愁无伤逃课打法攻略 07-30
- 明末渊虚之羽铜灯盏在哪里获取 铜灯盏获得方法介绍 07-30