总是觉得这个题目比较绕口!但是,琢磨了半天也没想出个更能让人一看就明了的人话…………

算了,写内容吧,对于我来讲这个更像人话 ^_^


以在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了!


太多了,不多写了,有些基础的人一看就明白了!

posted on 2004-06-25 23:06  雪美·考拉  阅读(1692)  评论(3编辑  收藏  举报