VB控件随窗体高宽度变化
Option Explicit
Dim FormOWidth As Long, FormOHeight As Long '窗体原始宽度,原始高度
Private Sub ResizerInit(FormName As Form) '在调用ResizerForm前先调用本函数
On Error Resume Next
Dim Obj As Control
FormOWidth = FormName.ScaleWidth
FormOHeight = FormName.ScaleHeight
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
End Sub
Private Sub ResizerForm(FormName As Form) '按比例改变表单内各元件的大小,'在调用ResizerForm前先调用ResizerInit函数
On Error Resume Next
Dim Pos(4) As Double, i As Long, TempPos As Long, StartPos As Long, Obj As Control, ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / FormOWidth '保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / FormOHeight '保存窗体高度缩放比例
For Each Obj In FormName
StartPos = 1
For i = 0 To 4
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare) '读取控件的原始位置与大小
If TempPos > 0 Then
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
Next i
Next Obj
End Sub
Private Sub Form_Resize()
If FormOWidth <> 0 And FormOHeight <> 0 Then Call ResizerForm(Me) '窗体改变时改变控件
End Sub
Private Sub Form_Load()
Call ResizerInit(Me) '获取起始窗体控件尺寸
End Sub