VB6 仿.netWinfrom控件 Anchor属性类

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 + 1
End Sub
Public Sub InitFromAllControl()
'把所有控件初始位置大小都保存
    If lFrom Is Nothing Then Exit Sub
    If iCIndex <> 1 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 + 1
    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(1 To lFrom.Controls.Count)
End Property

Private Sub Class_Initialize()
    iCIndex = 1
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
复制代码

   效果图:

        

   

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

原文地址:https://www.cnblogs.com/czhelp/p/3164132.html