VB 控件随窗体缩放

Option Explicit

Private FormOldWidth As Long

Private FormOldHeight As Long

Private count1 As Integer

Public Sub ResizeInit(FormName As Form)

Dim Obj As Control

FormOldWidth = FormName.ScaleWidth

FormOldHeight = FormName.ScaleHeight

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

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 / FormOldWidth

ScaleY = FormName.ScaleHeight / FormOldHeight

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) = VBA.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

On Error GoTo 0

End Sub

Private Sub Form_Load()

Image1.Picture = LoadPicture(App.Path + "\logo.jpg")

Call ResizeInit(Me)

End Sub

Private Sub Form_Resize()

Call ResizeForm(Me)

End Sub