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了！

太多了，不多寫了，有些基礎的人一看就明白了！