VB6创建的ActiveX控件中实现对目标载体的SubClass
总是觉得这个题目比较绕口！但是，琢磨了半天也没想出个更能让人一看就明了的人话…………
算了，写内容吧，对于我来讲这个更像人话 ^_^
以在VB6中实现窗体可调整到的最大或最小尺寸这一过程为例：
当然在.NET里这个最终效果的实现只需要对Form.MaximumSize和Form.MinimumSize 属性做以定义即可！
在VB6的岁月里，这个是要求程序员们自己来回调处理WM_GETMINMAXINFO消息的！
一般在面向窗体的工程里实现这个效果并不是很困难的，只需要SubClass处理WM_GETMINMAXINFO即可！具体方法自己已经写过两篇类似的文章了，不多说了！
问题是这个效果在开发中可能是经常要用到的，所以想到了把它封装成一个ActiveX控件，以便日后经常复用，但是这就要求在ActiveX控件里处理目标窗体的窗口函数了！WinProc放在哪里？又要怎么处理呢？
对于这个问题的，是这样考虑的：WinProc当然是要放在一个Module里了！这个Module自然应该在ActiveX里，这才叫封装嘛…………接着就好办了，怎么在ActiveX里来处理载体的窗口过程呢？
答：用GetProp函数把它映射过来！
具体代码实现如下：
一、建立ActiveX控件工程
二、给UserControl命名FormSize[名称你可以自由更换]，记住UserControl的Name这一点对于本例的实现是很重要的！
三、添加Module，命名FormSizeModule，键入以下代码：
Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpDest As Any, lpSource As Any, ByVal cBytes&)
Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal MSG&, ByVal wParam&, ByVal lParam&)
Public Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
Public Declare Function SetProp Lib "user32.dll" Alias "SetPropA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long
Public Declare Function GetProp Lib "user32.dll" Alias "GetPropA" ( _
ByVal hwnd As Long, _
ByVal lpString As String) As Long
Public Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" ( _
ByVal hwnd As Long, _
ByVal lpString As String) As Long
Type POINTAPI
x As Long
y As Long
End Type
Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Public Const WM_GETMINMAXINFO As Long = &H24
Public Const GWL_WNDPROC As Long = (-4&)
'窗体的窗口函数
Public Function Form_WndProc(ByVal hwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim skForm As FormSize
Dim lngPropAddress As Long
'从窗体中取得属性 FormSize 地址
lngPropAddress = GetProp(hwnd, "FormSize")
If lngPropAddress <> 0 Then
'从内存中复制 FormSize 对象
CopyMemory skForm, lngPropAddress, &H4
'处理窗体接收到的消息
Form_WndProc = skForm.WindowProc(hwnd, Message, wParam, lParam)
'清除 FormSize 对象
CopyMemory skForm, 0&, &H4
End If
End Function
四、在UserControl的代码窗口里键入以下代码：
Option Explicit
Private blRun As Boolean
Private frmhWnd As Long
Private frmBody As Form
Private mMaxWidth As Integer
Private mMaxHeight As Integer
Private mMinWidth As Integer
Private mMinHeight As Integer
Private lngPrevWndProc As Long
Private Sub UserControl_Initialize()
mMaxWidth = Screen.Width / Screen.TwipsPerPixelX
mMaxHeight = Screen.Height / Screen.TwipsPerPixelY
mMinWidth = 0
mMinHeight = 0
blRun = False
End Sub
Private Sub UserControl_InitProperties()
Dim frmObject As Object
For Each frmObject In UserControl.ParentControls
If TypeOf frmObject Is Form Then
Set frmBody = frmObject
frmhWnd = frmBody.hwnd
Exit For
End If
Next
If frmBody Is Nothing Then
Exit Sub
End If
Set frmObject = Nothing
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Dim frmObject As Object
mMinWidth = PropBag.ReadProperty("MinWidth", mMinWidth)
mMinHeight = PropBag.ReadProperty("MinHeight", mMinHeight)
mMaxWidth = PropBag.ReadProperty("MaxWidth", mMaxWidth)
mMaxHeight = PropBag.ReadProperty("MaxHeight", mMaxHeight)
blRun = PropBag.ReadProperty("RunLimitSize", blRun)
For Each frmObject In UserControl.ParentControls
If TypeOf frmObject Is Form Then
Set frmBody = frmObject
frmhWnd = frmBody.hwnd
Exit For
End If
Next
If frmBody Is Nothing Then
Exit Sub
End If
If blRun Then
SubClass frmhWnd
Else
UnSubClass frmhWnd
End If
End Sub
Private Sub UserControl_Resize()
Size 32 * Screen.TwipsPerPixelX, 32 * Screen.TwipsPerPixelY
End Sub
Public Property Get MaxWidth() As Integer
MaxWidth = mMaxWidth
End Property
Public Property Let MaxWidth(ByVal vNewValue As Integer)
mMaxWidth = vNewValue
PropertyChanged "MaxWidth"
End Property
Public Property Get MaxHeight() As Integer
MaxHeight = mMaxHeight
End Property
Public Property Let MaxHeight(ByVal vNewValue As Integer)
mMaxHeight = vNewValue
PropertyChanged "MaxHeight"
End Property
Public Property Get MinWidth() As Integer
MinWidth = mMinWidth
End Property
Public Property Let MinWidth(ByVal vNewValue As Integer)
mMinWidth = vNewValue
PropertyChanged "MinWidth"
End Property
Public Property Get MinHeight() As Integer
MinHeight = mMinHeight
End Property
Public Property Let MinHeight(ByVal vNewValue As Integer)
mMinHeight = vNewValue
PropertyChanged "MinHeight"
End Property
Private Sub UserControl_Terminate()
SetWindowLong frmhWnd, GWL_WNDPROC, lngPrevWndProc
Set frmBody = Nothing
End Sub
Public Property Get RunLimitSize() As Boolean
RunLimitSize = blRun
End Property
Public Property Let RunLimitSize(ByVal vNewValue As Boolean)
blRun = vNewValue
PropertyChanged "RunLimitSize"
If blRun Then
SubClass frmhWnd
Else
UnSubClass frmhWnd
End If
End Property
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "MinHeight", mMinHeight, 0
PropBag.WriteProperty "MinWidth", mMinWidth, 0
PropBag.WriteProperty "MaxHeight", mMaxHeight, Screen.Height / Screen.TwipsPerPixelY
PropBag.WriteProperty "MaxWidth", mMaxWidth, Screen.Width / Screen.TwipsPerPixelX
PropBag.WriteProperty "RunLimitSize", blRun, False
End Sub
Friend Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim udtMINMAXINFO As MINMAXINFO
Select Case iMsg
Case WM_GETMINMAXINFO '<-------------Limit the window size
CopyMemory udtMINMAXINFO, ByVal lParam, 40&
With udtMINMAXINFO
.ptMaxTrackSize.x = mMaxWidth
.ptMaxTrackSize.y = mMaxHeight
.ptMinTrackSize.x = mMinWidth
.ptMinTrackSize.y = mMinHeight
End With
CopyMemory ByVal lParam, udtMINMAXINFO, 40&
WindowProc = False
Exit Function
End Select
WindowProc = CallWindowProc(lngPrevWndProc, hwnd, iMsg, wParam, lParam)
End Function
Private Sub SubClass(ByVal hwnd As Long)
If lngPrevWndProc <> 0 Then UnSubClass hwnd
lngPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf Form_WndProc)
SetProp hwnd, "FormSize", ObjPtr(Me)
End Sub
Private Sub UnSubClass(ByVal hwnd As Long)
If lngPrevWndProc <> 0 Then
RemoveProp hwnd, "FormSize"
lngPrevWndProc = 0
SetWindowLong hwnd, GWL_WNDPROC, lngPrevWndProc
End If
End Sub
5、编译并生成控件！
6、另外新开一个IDE，建立EXE工程，引用这个ActiveX控件，并设置好对应的属性，F5，OK了！
太多了，不多写了，有些基础的人一看就明白了！