原创技术分享: ControlsAnchor.cls 什么东东?你懂的^-^
原创技术分享: ControlsAnchor.cls 什么东东?你懂的^-^
'---------------------------------------------------
' 模块名 : 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
学习了。
不错
路过
