一个老外写的控件自适应窗体大小变化的完美代码
’类模块:clsAutoPositioner
Option Explicit
Dim m_oAssignments As New Collection
Public Function AddAssignment(ctl As Object, _
ctlRelative As Object, _
tPosType As tPOSITION_TYPE)
Dim x As New clsAutoPositionerItem
Set x.oCTL = ctl
Set x.oREL = ctlRelative
x.tPosType = tPosType
Select Case x.tPosType
Case tCONTAINER_RELATIVE_POS_RIGHT:
x.lValue = x.oREL.Width - x.oCTL.Left
Case tCONTAINER_RELATIVE_POS_BOTTOM:
x.lValue = x.oREL.Height - x.oCTL.Top
Case tCONTAINER_WIDTH_DELTA_RIGHT:
x.lValue = x.oREL.Width - (x.oCTL.Left + x.oCTL.Width)
Case tCONTAINER_HEIGHT_DELTA_BOTTOM:
x.lValue = x.oREL.Height - (x.oCTL.Top + x.oCTL.Height)
Case tCONTROL_RELATIVE_SAME_POS_VERTICAL:
x.lValue = x.oCTL.Left - x.oREL.Left
Case tCONTROL_RELATIVE_SAME_POS_HORIZONTAL:
x.lValue = x.oCTL.Top - x.oREL.Top
End Select
m_oAssignments.Add x
End Function
Public Function RefreshPositions()
Dim i As Long
Dim x As clsAutoPositionerItem
Dim erg As Long
For i = 1 To m_oAssignments.Count
Set x = m_oAssignments.Item(i)
Select Case x.tPosType
Case tCONTAINER_RELATIVE_POS_RIGHT:
erg = x.oREL.Width - x.lValue
If (erg > 0) Then x.oCTL.Left = erg
Case tCONTAINER_RELATIVE_POS_BOTTOM:
erg = x.oREL.Height - x.lValue
If (erg > 0) Then x.oCTL.Top = erg
Case tCONTAINER_WIDTH_DELTA_RIGHT:
erg = x.oREL.Width - x.oCTL.Left - x.lValue
If (erg > 0) Then x.oCTL.Width = erg
Case tCONTAINER_HEIGHT_DELTA_BOTTOM:
erg = x.oREL.Height - x.oCTL.Top - x.lValue
If (erg > 0) Then
x.oCTL.Height = erg
Else
erg = erg
End If
Case tCONTROL_RELATIVE_SAME_POS_VERTICAL:
erg = x.oREL.Left + x.lValue
x.oCTL.Left = erg
Case tCONTROL_RELATIVE_SAME_POS_HORIZONTAL:
erg = x.oREL.Top + x.lValue
x.oCTL.Top = erg
End Select
Next
End Function
’//
’类模块:clsAutoPositionerItem
Public Enum tPOSITION_TYPE
tCONTAINER_RELATIVE_POS_RIGHT
tCONTAINER_RELATIVE_POS_BOTTOM
tCONTAINER_WIDTH_DELTA_RIGHT
tCONTAINER_HEIGHT_DELTA_BOTTOM
tCONTROL_RELATIVE_SAME_POS_VERTICAL
tCONTROL_RELATIVE_SAME_POS_HORIZONTAL
End Enum
Public oCTL As Object
Public oREL As Object
Public tPosType As tPOSITION_TYPE
Public lValue As tPOSITION_TYPE
’//
’窗体代码:
Option Explicit
Dim m_oAutoPos As New clsAutoPositioner
Private Sub Form_Load()
’ Always relative to container’s right border
m_oAutoPos.AddAssignment Me.Command1, Me, tCONTAINER_RELATIVE_POS_RIGHT
’ Auto resizing horizontally
m_oAutoPos.AddAssignment Me.Command2, Me, tCONTAINER_WIDTH_DELTA_RIGHT
’ Auto resizing vertically
m_oAutoPos.AddAssignment Me.Command3, Me, tCONTAINER_HEIGHT_DELTA_BOTTOM
’ Always relative to container’s bottom border
m_oAutoPos.AddAssignment Me.Command4, Me, tCONTAINER_RELATIVE_POS_BOTTOM
’ Auto resizing horizontally + Auto resizing vertically
m_oAutoPos.AddAssignment Me.Command5, Me, tCONTAINER_WIDTH_DELTA_RIGHT
m_oAutoPos.AddAssignment Me.Command5, Me, tCONTAINER_HEIGHT_DELTA_BOTTOM
End Sub
Private Sub Form_Resize()
m_oAutoPos.RefreshPositions
End Sub
控件自适应窗体大小
最新推荐文章于 2023-11-23 14:12:56 发布