Public fbl As Integer
Public shuiping As Integer
Public cuizhi As Integer
Sub SetDeviceIndependentWindow(thisform As Form)
Dim Obj As Control
Dim DesignX As Integer
Dim DesignY As Integer
Dim XFactor As Single
Dim YFactor As Single
Dim X As Integer
DesignX = 1440: DesignY = 900
XFactor = (Screen.Width / Screen.TwipsPerPixelX) / DesignX
YFactor = (Screen.Height / Screen.TwipsPerPixelY) / DesignY
If XFactor = 1 And YFactor = 1 Then
fbl = 0
Else: fbl = 1
End If
End Sub
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 = shuiping / 1440
ScaleY = cuizhi / 900
On Error Resume Next
For Each Obj In formname
StartPos = 1
For i = 0 To 3
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
pos(i) = Val(Mid(Obj.Tag, StartPos, TempPos - StartPos))
StartPos = TempPos + 1
Else
pos(i) = 0
End If
Next i
Obj.Move pos(0) * ScaleX, pos(1) * ScaleY, pos(2) * ScaleX, pos(3) * ScaleY
If TypeOf Obj Is OptionButton Then
Obj.FontSize = Obj.FontSize * ScaleX
ElseIf TypeOf Obj Is ComboBox Then
Obj.FontSize = Obj.FontSize * ScaleX
ElseIf TypeOf Obj Is TextBox Then
Obj.FontSize = Obj.FontSize * ScaleX
ElseIf TypeOf Obj Is Label Then
Obj.FontSize = Obj.FontSize * ScaleX
ElseIf TypeOf Obj Is CheckBox Then
Obj.FontSize = Obj.FontSize * ScaleX
ElseIf TypeOf Obj Is CommandButton Then
Obj.FontSize = Obj.FontSize * ScaleX
ElseIf TypeOf Obj Is Frame Then
Obj.FontSize = Obj.FontSize * ScaleX
End If
Next Obj
On Error GoTo 0
End Sub
Public Sub ResizeInit(formname As Form)
Dim Obj As Control
On Error Resume Next
For Each Obj In formname
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0
End Sub
试试这个,不过据说这种遍历函数并不是对所有的控件都适用