//让控件随窗体大小变化自动调整大小 怎么实现??模块: Option ExplicitPrivate ObjOldWidth As Long '保存窗体的原始宽度 Private ObjOldHeight As Long '保存窗体的原始高度 Private ObjOldFont As Single '保存窗体的原始字体比'在调用ResizeForm前先调用本函数 Public Sub ResizeInit(FormName As Form) Dim Obj As Control
For Each Obj In FormName Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " " Next Obj
On Error GoTo 0End Sub'按比例改变表单内各元件的大小, '在调用ReSizeForm前先调用ReSizeInit函数 Public Sub ResizeForm(FormName As Form) Dim Pos(4) As Double Dim i As Long, TempPos As Long, StartPos As Long Dim Obj As Control Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / ObjOldWidth '保存窗体宽度缩放比例 ScaleY = FormName.ScaleHeight / ObjOldHeight '保存窗体高度缩放比例 On Error Resume Next
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
反正代码也不复杂,慢慢调吧,呵呵PS:我一直都是这么做的:)
怎么实现??模块:
Option ExplicitPrivate ObjOldWidth As Long '保存窗体的原始宽度
Private ObjOldHeight As Long '保存窗体的原始高度
Private ObjOldFont As Single '保存窗体的原始字体比'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form) Dim Obj As Control
ObjOldWidth = FormName.ScaleWidth
ObjOldHeight = FormName.ScaleHeight
ObjOldFont = FormName.Font.Size / ObjOldHeightOn Error Resume Next
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0End Sub'按比例改变表单内各元件的大小,
'在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form) Dim Pos(4) As Double
Dim i As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / ObjOldWidth
'保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / ObjOldHeight
'保存窗体高度缩放比例
On Error Resume Next
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
Obj.Font.Size = ObjOldFont * FormName.ScaleHeight
Next i
Next Obj
On Error GoTo 0End Sub窗体
Option ExplicitPrivate Sub Form_Resize() '确保窗体改变时控件随之改变
Call ResizeForm(Me)
End SubPrivate Sub Form_Load() '在程序装入时必须加入
Call ResizeInit(Me)
End Sub