原创技术分享: ControlsAnchor.cls 什么东东?你懂的^-^

bcrun 2013-04-29 05:49:30

加精



'---------------------------------------------------------------------------------------

' 模块名    : CControlExtender.cls

' 时间      : 2013/4/29

' 作者      : 杨过.网狐.cn(csdn bcrun)

' 功能      :

' 说明      :

' 备注      : 星辰设计室VB一群:283362041,星辰学园BASIC辅导群:289219875

'---------------------------------------------------------------------------------------

Option Explicit



Public Enum AnchorStyles

    None = 0                                                                    '该控件未锚定到其容器的任何边缘。

    Top = 1                                                                     '该控件锚定到其容器的上边缘。

    Bottom = 2                                                                  '该控件锚定到其容器的下边缘。

    Left = 4                                                                    '该控件锚定到其容器的左边缘。

    Right = 8                                                                   '该控件锚定到其容器的右边缘。

    All = Top + Bottom + Left + Right

End Enum



Public Enum DockStyle                                                           '指定控件停靠的位置和方式。

    None = 0                                                                    '该控件未停靠。

    Top = 1                                                                     '该控件的上边缘停靠在其包含控件的顶端。

    Bottom = 2                                                                  '该控件的下边缘停靠在其包含控件的底部。

    Left = 3                                                                    '该控件的左边缘停靠在其包含控件的左边缘。

    Right = 4                                                                   '该控件的右边缘停靠在其包含控件的右边缘。

    Fill = 5                                                                    '控件的各个边缘分别停靠在其包含控件的各个边缘，并且适当调整大小。

End Enum

Private m_eAnchor As AnchorStyles

Public LeftSpace As Single

Public TopSpace As Single

Public RightSpace As Single

Public BottomSpace As Single

Public AnchorControl As Control





Public Property Get Anchor() As AnchorStyles

    

    Anchor = m_eAnchor

    

End Property



Public Property Let Anchor(ByVal eAnchor As AnchorStyles)



    m_eAnchor = eAnchor



End Property



'---------------------------------------------------------------------------------------

' 模块名    : CControlsAnchor.cls

' 时间      : 2013/4/29

' 作者      : 杨过.网狐.cn(csdn bcrun)

' 功能      :

' 说明      :

' 备注      : 星辰设计室VB一群:283362041,星辰学园BASIC辅导群:289219875

'---------------------------------------------------------------------------------------

Option Explicit



Private fbResizeInitOk As Boolean                                               'ResizeInit结束的标识，方便实现在调用ReSizeForm前先调用ReSizeInit过程

'下面几个变量的定义供扩展功能备用

Private fFormOldWidth As Single                                                 '保存窗体的原始宽度

Private fFormOldHeight As Single                                                '保存窗体的原始高度

Private fObjOldFont As Single                                                   '保存窗体的原始字体比



Private fFormParent As Form

Private fContainer As Object

Private WithEvents fPicBoxResizable As VB.PictureBox

Private WithEvents fFormResizable As VB.Form

Private fCtrlCols As New Collection

Private fAnchor As AnchorStyles

Private Type TCtl

    Anchor As AnchorStyles

End Type

Private fCtl As TCtl

'在调用ResizeForm前先调用本过程

Public Sub Init(ByVal AFormParent As Form, Optional AContainer As Object)

    Dim oCtl As Control

    Dim oCtlExt As CControlExtender

    If (IsMissing(AContainer) Or (AContainer Is Nothing)) Then

        Set fContainer = AFormParent

    Else

        Set fContainer = AContainer

        

    End If

    If (TypeOf fContainer Is PictureBox) Then

        Set fPicBoxResizable = fContainer

    ElseIf (TypeOf fContainer Is Form) Then

        Set fFormResizable = fContainer

        

    End If

    Set fFormParent = AFormParent



    On Error Resume Next



    On Error GoTo 0

    fbResizeInitOk = True

End Sub

Public Sub AddControl(AItemName As String, oCtl As Control, AAnchorStyles As AnchorStyles)

    Dim oCtlExt As New CControlExtender

    oCtlExt.Anchor = AAnchorStyles

        With oCtlExt

            .LeftSpace = oCtl.Left

            .TopSpace = oCtl.Top

            .RightSpace = fContainer.ScaleLeft + fContainer.ScaleWidth - (oCtl.Left + oCtl.Width)

            .BottomSpace = fContainer.ScaleTop + fContainer.ScaleHeight - (oCtl.Top + oCtl.Height)

        End With

        Set oCtlExt.AnchorControl = oCtl

    Call fCtrlCols.Add(oCtlExt, oCtl.Name)

End Sub

Public Sub Resize()

    Dim oCtl As Control

    Dim oCtlExt As CControlExtender

    Dim oFormParent As Form

    On Error Resume Next

    Set oFormParent = fFormParent

    For Each oCtlExt In fCtrlCols

'        If Not (oCtl.Container Is fContainer) Then

'            GoTo ContinueoCtl

'        End If

        Set oCtl = oCtlExt.AnchorControl

        If ((oCtlExt.Anchor And AnchorStyles.Left) <> 0) And _

            ((oCtlExt.Anchor And AnchorStyles.Right) <> 0) Then

            With oCtl

                .Width = fContainer.ScaleLeft + fContainer.ScaleWidth - oCtlExt.RightSpace - oCtl.Left

            End With

        ElseIf ((oCtlExt.Anchor And AnchorStyles.Right) <> 0) Then

            With oCtl

                .Left = fContainer.ScaleLeft + fContainer.ScaleWidth - oCtl.Width - oCtlExt.RightSpace

            End With

        End If

        If ((oCtlExt.Anchor And AnchorStyles.Top) <> 0) And _

            ((oCtlExt.Anchor And AnchorStyles.Bottom) <> 0) Then

            With oCtl

                .Height = fContainer.ScaleTop + fContainer.ScaleHeight - oCtlExt.BottomSpace - oCtl.Top

            End With

        ElseIf ((oCtlExt.Anchor And AnchorStyles.Bottom) <> 0) Then

            With oCtl

                .Top = fContainer.ScaleTop + fContainer.ScaleHeight - oCtl.Height - oCtlExt.BottomSpace

            End With

        End If



ContinueoCtl:

    Next oCtlExt

End Sub







Private Sub fFormResizable_Resize()

    Call Resize

End Sub



Private Sub fPicBoxResizable_Resize()

    Call Resize

End Sub



VERSION 5.00

Begin VB.Form Form1 

   Caption         =   "Form1"

   ClientHeight    =   4050

   ClientLeft      =   120

   ClientTop       =   450

   ClientWidth     =   7365

   BeginProperty Font 

      Name            =   "Tahoma"

      Size            =   8.25

      Charset         =   0

      Weight          =   400

      Underline       =   0   'False

      Italic          =   0   'False

      Strikethrough   =   0   'False

   EndProperty

   LinkTopic       =   "Form1"

   ScaleHeight     =   4050

   ScaleWidth      =   7365

   ShowInTaskbar   =   0   'False

   StartUpPosition =   3  '窗口缺省

   Begin VB.CommandButton cmdOk 

      Caption         =   "Ok"

      Height          =   360

      Left            =   6120

      TabIndex        =   4

      Top             =   2760

      Width           =   990

   End

   Begin VB.CommandButton cmdAbout 

      Caption         =   "About"

      Height          =   360

      Left            =   6000

      TabIndex        =   3

      Top             =   360

      Width           =   990

   End

   Begin VB.PictureBox Picture1 

      Height          =   2535

      Left            =   960

      ScaleHeight     =   2475

      ScaleWidth      =   4395

      TabIndex        =   0

      TabStop         =   0   'False

      Top             =   1080

      Width           =   4455

      Begin VB.CommandButton cmdCommand1 

         Caption         =   "Command1"

         Height          =   360

         Left            =   3240

         TabIndex        =   2

         Top             =   1800

         Width           =   990

      End

      Begin VB.TextBox txtText1 

         Height          =   615

         Left            =   720

         MultiLine       =   -1  'True

         TabIndex        =   1

         Text            =   "Form1.frx":0000

         Top             =   480

         Width           =   1215

      End

   End

End

Attribute VB_Name = "Form1"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Option Explicit

Private m_Sizer As New CControlsAnchor

Private m_PicBoxSizer As New CControlsAnchor

Private Sub Form_Load()

    '下一句体现了VB6 forms的特点,Controls集合里连PictureBox容器内的控件都算上了,而PictureBox

    '本身并没有Controls,可见在项目代码移植时,这会引起不必要的麻烦.

    Caption = Me.Controls.Count

    Call m_Sizer.Init(Me)

    Call m_Sizer.AddControl("cmdOk", cmdOk, AnchorStyles.Bottom + AnchorStyles.Right)

    Call m_Sizer.AddControl("cmdAbout", cmdAbout, AnchorStyles.Top + AnchorStyles.Right)

    Call m_Sizer.AddControl("Picture1", Picture1, AnchorStyles.All)

    Call m_PicBoxSizer.Init(Me, Picture1)

    Call m_Sizer.AddControl("cmdCommand1", cmdCommand1, AnchorStyles.Bottom + AnchorStyles.Right)

    Debug.Print txtText1.Parent.Name

End Sub