VB6 仿.netWinfrom控件 Anchor属性类

时间:2023-03-08 21:00:43

    vb6中控件没有anchor与dock属性,窗体变大后原来要在resize中调整控件的move属性,否则就面目全非了.网上找到一些调整控件大小的代码,发现并不太适合自己,于是按照思路自己做了一个类似anchor属性的类模块。

    代码如下:

Option Explicit
'设置控件Left,Top,Height,Width 类似Anchor属性 '控件大小与位置
Private Type cP
Wp As Single
Hp As Single
Tp As Single
Lp As Single
End Type Private ccp() As cP
Private iCIndex As Integer '控件的index
Private colControl As New Collection
Private frmOldWidth As Single '记录下原始窗口值宽与高
Private frmOldHeight As Single
Private lFrom As Form Public Sub InitControlSize(strCName As String)
'存控件初始位置
colControl.Add iCIndex, strCName ccp(iCIndex).Lp = lFrom.Controls(strCName).Left
ccp(iCIndex).Tp = lFrom.Controls(strCName).Top
ccp(iCIndex).Hp = lFrom.Controls(strCName).Height
ccp(iCIndex).Wp = lFrom.Controls(strCName).Width iCIndex = iCIndex +
End Sub
Public Sub InitFromAllControl()
'把所有控件初始位置大小都保存
If lFrom Is Nothing Then Exit Sub
If iCIndex <> Then Exit Sub Dim myControl As Control
For Each myControl In lFrom.Controls
colControl.Add iCIndex, myControl.Name
ccp(iCIndex).Lp = myControl.Left
ccp(iCIndex).Tp = myControl.Top
ccp(iCIndex).Hp = myControl.Height
ccp(iCIndex).Wp = myControl.Width
iCIndex = iCIndex +
Next
End Sub Public Sub ControlAnchor(strCName As String, _
Optional bLeft As Boolean = False, _
Optional bTop As Boolean = False, _
Optional bHeight As Boolean = False, _
Optional bWidth As Boolean = False)
On Error Resume Next
Dim fHorizontal As Single
Dim fVertical As Single
Dim index As Integer fHorizontal = lFrom.ScaleWidth - frmOldWidth '横坐标 对应 left、width属性
fVertical = lFrom.ScaleHeight - frmOldHeight '纵坐标 对应 Top、Height属性
index = colControl.Item(strCName) '从集合里取得控件的index If bLeft Then lFrom.Controls(strCName).Left = fHorizontal + ccp(index).Lp
If bTop Then lFrom.Controls(strCName).Top = fVertical + ccp(index).Tp
If bHeight Then lFrom.Controls(strCName).Height = fVertical + ccp(index).Hp
If bWidth Then lFrom.Controls(strCName).Width = fHorizontal + ccp(index).Wp End Sub
Public Property Set setFrom(ByVal sValue As Form)
Set lFrom = sValue
frmOldWidth = lFrom.ScaleWidth
frmOldHeight = lFrom.ScaleHeight
ReDim ccp( To lFrom.Controls.Count)
End Property Private Sub Class_Initialize()
iCIndex =
End Sub Private Sub Class_Terminate()
Set lFrom = Nothing
End Sub

    调用方法:

Option Explicit
Dim myAnchor As New clsAnchor Private Sub Form_Load()
Set myAnchor.setFrom = Me
myAnchor.InitFromAllControl
End Sub Private Sub Form_Resize()
myAnchor.ControlAnchor "gridOrder", , , True, True
myAnchor.ControlAnchor "Frame2", , , , True
End Sub

   效果图:

VB6 仿.netWinfrom控件 Anchor属性类

   VB6 仿.netWinfrom控件 Anchor属性类

  Collection集合效率不高,可以换成哈希表。