scalewidth

2023年4月6日发(作者：各种操作系统)在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小，如：



Private Sub Form_Resize()

Dim H, i As Integer

On Error Resume Next

Resize_ALL Me 'Me是窗体名，Form1,Form2等等都可以



End Sub



在模块中添加以下代码：



Public Type ctrObj

Name As String

Index As Long

Parrent As String

Top As Long

Left As Long

Height As Long

Width As Long

ScaleHeight As Long

ScaleWidth As Long

End Type



Private FormRecord() As ctrObj

Private ControlRecord() As ctrObj

Private bRunning As Boolean

Private MaxForm As Long

Private MaxControl As Long

Private Const WM_NCLBUTTONDOWN = &HA1

Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function ReleaseCapture Lib "USER32" () As Long



Function ActualPos(plLeft As Long) As Long



If plLeft < 0 Then

ActualPos = plLeft + 75000

Else

ActualPos = plLeft

End If



End Function



Function FindForm(pfrmIn As Form) As Long



Dim i As Long

FindForm = -1



If MaxForm > 0 Then



For i = 0 To (MaxForm - 1)

If FormRecord(i).Name = Then

FindForm = i

Exit Function

End If

Next i

End If



End Function





Function AddForm(pfrmIn As Form) As Long



Dim FormControl As Control

Dim i As Long

ReDim Preserve FormRecord(MaxForm + 1)



FormRecord(MaxForm).Name =

FormRecord(MaxForm).Top =

FormRecord(MaxForm).Left =

FormRecord(MaxForm).Height =

FormRecord(MaxForm).Width =

FormRecord(MaxForm).ScaleHeight = eight

FormRecord(MaxForm).ScaleWidth = idth

AddForm = MaxForm

MaxForm = MaxForm + 1



For Each FormControl In pfrmIn

i = FindControl(FormControl, )

If i < 0 Then

i = AddControl(FormControl, )

End If

Next FormControl



End Function



Function FindControl(inControl As Control, inName As String) As Long



Dim i As Long

FindControl = -1



For i = 0 To (MaxControl - 1)

If ControlRecord(i).Parrent = inName Then

If ControlRecord(i).Name = Then

On Error Resume Next

If ControlRecord(i).Index = Then

FindControl = i

Exit Function

End If

On Error GoTo 0

End If

End If

Next i

End Function



Function AddControl(inControl As Control, inName As String) As Long



ReDim Preserve ControlRecord(MaxControl + 1)

On Error Resume Next

ControlRecord(MaxControl).Name =

ControlRecord(MaxControl).Index =

ControlRecord(MaxControl).Parrent = inName



If TypeOf inControl Is Line Then

ControlRecord

(MaxControl).Top = inControl.Y1

ControlRecord(MaxControl).Left = ActualPos(inControl.X1)

ControlRecord(MaxControl).Height = inControl.Y2

ControlRecord(MaxControl).Width = ActualPos(inControl.X2)

Else

ControlRecord(MaxControl).Top =

ControlRecord(MaxControl).Left = ActualPos()

ControlRecord(MaxControl).Height =

ControlRecord(MaxControl).Width =

End If



alHeight = False

On Error GoTo 0

AddControl = MaxControl

MaxControl = MaxControl + 1

End Function



Function PerWidth(pfrmIn As Form) As Long



Dim i As Long

i = FindForm(pfrmIn)



If i < 0 Then

i = AddForm(pfrmIn)

End If



PerWidth = (idth * 100) FormRecord(i).ScaleWidth

End Function



Function PerHeight(pfrmIn As Form) As Double



Dim i As Long

i = FindForm(pfrmIn)



If i < 0 Then

i = AddForm(pfrmIn)

End If



PerHeight = (eight * 100) FormRecord(i).ScaleHeight

End Function



Public Sub ResizeControl(inControl As Control, pfrmIn As Form)



On Error Resume Next

Dim i As Long

Dim widthfactor As Single, heightfactor As Single

Dim minFactor As Single

Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long

yRatio = PerHeight(pfrmIn)

xRatio = PerWidth(pfrmIn)

i = FindControl(inControl, )



If < 0 Then

lLeft = CLng(((ControlRecord(i).Left * xRatio) 100) - 75000)

Else

lLeft = CLng((ControlRecord(i).Left * xRatio) 100)

End If



lTop = CLng((ControlRecord(i).Top * yRatio) 100)

lWidth = CLng((ControlRecord(i).Width * xRatio) 100)

lHeight = CLng((ControlRecord(i).Height * yRatio) 100)

If TypeOf inControl Is Line Then



If inControl.X1 < 0 Then

inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) 100) - 75000)

Else

inControl.X1 = CLng((ControlRecord(i).Left * xRatio) 100)

End If



inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) 100)

If inControl.X2 < 0 Then

inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) 100) - 75000)

Else

inControl.X2 = CLng((ControlRecord(i).Width * xRatio) 100)

End If



inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) 100)

Else

lLeft, lTop, lWidth, lHeight

lLeft, lTop, lWidth

lLeft, lTop

End If



End Sub



Public Sub ResizeForm(pfrmIn As Form)



Dim FormControl As Control

Dim isVisible As Boolean

Dim StartX, StartY, MaxX, MaxY As Long

Dim bNew As Boolean



If Not bRunning Then

bRunning = True



If FindForm(pfrmIn) < 0 Then

bNew = True

Else

bNew = False

End If

If < 30000 Then

isVisible = e

On Error Resume Next

If Not pfrmI

Exit Sub

End If

Next i

End If

End Sub



Public Sub Resize_ALL(Form_Name As Form)



Dim OBJ As Object

For Each OBJ In Form_Name

ResizeControl OBJ, Form_Name

Next OBJ

End Sub



Public Sub DragForm(frm As Form)



On Local Error Resume Next

Call ReleaseCapture

Call SendMessage(, WM_NCLBUTTONDOWN, 2, 0)



End Sub