1,451
社区成员
发帖
与我相关
我的任务
分享
'---------------------------------------------------------------------------------------
' 模块名 : CControlExtender.cls
' 时间 : 2013/7/8
' 作者 : 杨过.网狐.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 MidPosXScale As Single '控件中间在横向上的坐标比例
Public MidPosYScale 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
' 版本时间 : 1.1版 2013/7/8
' 作者 : 杨过.网狐.cn(csdn bcrun)
' 功能 :
' 说明 : 本类的Anchor行为,参照.net中Windows.Forms的相差行为设计
' 备注 : 星辰设计室VB一群:283362041,星辰学园BASIC辅导群:289219875
'---------------------------------------------------------------------------------------
'更新历史:v1.1:新增:按比例定位,bug修补:针对VB6一次Form_Initialize后可能多次Form_Load的特点,及时释放fCtrlCols对象
Option Explicit
Private fbResizeInitOk As Boolean 'ResizeInit结束的标识,方便实现在调用ReSizeForm前先调用ReSizeInit过程
Private fFormOldWidth As Single '保存窗体的原始宽度
Private fFormOldHeight As Single '保存窗体的原始高度
Private fObjOldFont As Single '保存窗体的原始字体比
Private WithEvents 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
'在Form_Load中优先调用本过程
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
' fFormOldWidth = AFormParent.Width
' fFormOldHeight = AFormParent.Height
fFormOldWidth = fContainer.ScaleWidth
fFormOldHeight = fContainer.ScaleHeight
fObjOldFont = fContainer.Font.Size / fFormOldHeight
On Error Resume Next
For Each oCtl In AFormParent.Controls
If Not (oCtl.Container Is fContainer) Then
GoTo ContinueoCtl
End If
Set oCtlExt = New CControlExtender
oCtlExt.Anchor = AnchorStyles.Left Or AnchorStyles.Top Or AnchorStyles.Right Or AnchorStyles.Bottom
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
'Call fCtrlCols.Add(oCtlExt, oCtl.Name)
ContinueoCtl:
Next oCtl
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)
.MidPosXScale = ((oCtl.Left + oCtl.Width / 2) - fContainer.ScaleLeft) / fContainer.ScaleWidth
.MidPosYScale = ((oCtl.Top + oCtl.Height / 2) - fContainer.ScaleTop) / fContainer.ScaleHeight
End With
Set oCtlExt.AnchorControl = oCtl
Call fCtrlCols.Add(oCtlExt, AItemName)
End Sub
Public Sub Resize()
Dim oCtl As Control
Dim oCtlExt As CControlExtender
Dim oFormParent As Form
Dim sglCtlWidth As Single
On Error Resume Next
Set oFormParent = fFormParent
For Each oCtlExt In fCtrlCols
' If Not (oCtl.Container Is fContainer) Then
' GoTo ContinueoCtl
' End If
'Set oCtlExt = fCtrlCols.Item(oCtl.Name)
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
ElseIf ((oCtlExt.Anchor And (AnchorStyles.Left Or AnchorStyles.Right)) = 0) Then
With oCtl
sglCtlWidth = oCtl.Width
.Left = fContainer.ScaleLeft + fContainer.ScaleWidth * oCtlExt.MidPosXScale - oCtl.Width / 2
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
ElseIf ((oCtlExt.Anchor And (AnchorStyles.Top Or AnchorStyles.Bottom)) = 0) Then
With oCtl
.Top = fContainer.ScaleTop + fContainer.ScaleHeight * oCtlExt.MidPosYScale - oCtl.Height / 2
End With
End If
' If (TypeOf oCtl Is PictureBox) Or (TypeOf oCtl Is TextBox) Then
' With oCtl
' .Width = fContainer.ScaleLeft + fContainer.ScaleWidth - oCtlExt.RightSpace - oCtl.Left
' .Height = fContainer.ScaleTop + fContainer.ScaleHeight - oCtlExt.BottomSpace - oCtl.Top
' End With
' ElseIf (TypeOf oCtl Is Label) Then
'
' Else
' With oCtl
' .Left = fContainer.ScaleLeft + fContainer.ScaleWidth - oCtl.Width - oCtlExt.RightSpace
' .Top = fContainer.ScaleTop + fContainer.ScaleHeight - oCtl.Height - oCtlExt.BottomSpace
' End With
' End If
'oCtlExt.Anchor = AnchorStyles.Left Or AnchorStyles.Top Or AnchorStyles.Right Or AnchorStyles.Bottom
'Call fCtrlCols.Add(oCtlExt, oCtl.Name)
ContinueoCtl:
Next oCtlExt
End Sub
Private Sub fFormResizable_Resize()
Call Resize
End Sub
Private Sub fFormParent_Unload(Cancel As Integer)
Debug.Print "fFormParent_Unload"
'针对VB6一次Form_Initialize后可能多次Form_Load的特点,及时释放fCtrlCols对象,非常重要!
Set fCtrlCols = Nothing
End Sub
Private Sub fPicBoxResizable_Resize()
Call Resize
End Sub