有时窗体变化后，如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦，下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。 　　在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 = pfrmIn.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 = pfrmIn.Name 　　FormRecord(MaxForm).Top = pfrmIn.Top 　　FormRecord(MaxForm).Left = pfrmIn.Left 　　FormRecord(MaxForm).Height = pfrmIn.Height 　　FormRecord(MaxForm).Width = pfrmIn.Width 　　FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight 　　FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth 　　AddForm = MaxForm 　　MaxForm = MaxForm + 1 　　For Each FormControl In pfrmIn 　　i = FindControl(FormControl, pfrmIn.Name) 　　If i < 0 Then 　　　i = AddControl(FormControl, pfrmIn.Name) 　　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 = inControl.Name Then 　　　　On Error Resume Next 　　　　If ControlRecord(i).Index = inControl.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 = inControl.Name 　　ControlRecord(MaxControl).Index = inControl.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 = inControl.Top 　　ControlRecord(MaxControl).Left = ActualPos(inControl.Left) 　　ControlRecord(MaxControl).Height = inControl.Height 　　ControlRecord(MaxControl).Width = inControl.Width 　　End If 　　inControl.IntegralHeight = 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 = (pfrmIn.ScaleWidth * 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 = (pfrmIn.ScaleHeight * 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, pfrmIn.Name) 　　If inControl.Left < 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 　　inControl.Move lLeft, lTop, lWidth, lHeight 　　inControl.Move lLeft, lTop, lWidth 　　inControl.Move 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 pfrmIn.Top < 30000 Then 　　　isVisible = pfrmIn.Visible 　　　On Error Resume Next 　　　If Not pfrmIn.MDIChild Then 　　　　On Error GoTo 0 　　　　' ' pfrmIn.Visible = False 　　　Else 　　　　If bNew Then 　　　　　StartY = pfrmIn.Height 　　　　　StartX = pfrmIn.Width 　　　　　On Error Resume Next 　　　　　For Each FormControl In pfrmIn 　　　　　　If FormControl.Left + FormControl.Width + 200 > MaxX Then 　　　　　　　MaxX = FormControl.Left + FormControl.Width + 200 　　　　　　End If 　　　　　　If FormControl.Top + FormControl.Height + 500 > MaxY Then 　　　　　　　MaxY = FormControl.Top + FormControl.Height + 500 　　　　　　End If 　　　　　　If FormControl.X1 + 200 > MaxX Then 　　　　　　　MaxX = FormControl.X1 + 200 　　　　　　End If 　　　　　　If FormControl.Y1 + 500 > MaxY Then 　　　　　　　MaxY = FormControl.Y1 + 500 　　　　　　End If 　　　　　　If FormControl.X2 + 200 > MaxX Then 　　　　　　　MaxX = FormControl.X2 + 200 　　　　　　End If 　　　　　　If FormControl.Y2 + 500 > MaxY Then 　　　　　　　MaxY = FormControl.Y2 + 500 　　　　　　End If 　　　　　Next FormControl 　　　　　On Error GoTo 0 　　　　　pfrmIn.Height = MaxY 　　　　　pfrmIn.Width = MaxX 　　　　End If 　　　　On Error GoTo 0 　　　End If 　　　For Each FormControl In pfrmIn 　　　　ResizeControl FormControl, pfrmIn 　　　Next FormControl 　　　On Error Resume Next 　　　If Not pfrmIn.MDIChild Then 　　　　On Error GoTo 0 　　　　pfrmIn.Visible = isVisible 　　　Else 　　　　If bNew Then 　　　　pfrmIn.Height = StartY 　　　　pfrmIn.Width = StartX 　　　　For Each FormControl In pfrmIn 　　　　　ResizeControl FormControl, pfrmIn 　　　　Next FormControl 　　　End If 　　End If 　　On Error GoTo 0 　　End If 　　bRunning = False 　　End If 　　End Sub 　　Public Sub SaveFormPosition(pfrmIn As Form) 　　Dim i As Long 　　If MaxForm > 0 Then 　　For i = 0 To (MaxForm - 1) 　　　If FormRecord(i).Name = pfrmIn.Name Then 　　　　FormRecord(i).Top = pfrmIn.Top 　　　　FormRecord(i).Left = pfrmIn.Left 　　　　FormRecord(i).Height = pfrmIn.Height 　　　　FormRecord(i).Width = pfrmIn.Width 　　　　Exit Sub 　　　End If 　　Next i 　　AddForm (pfrmIn) 　　End If 　　End Sub 　　Public Sub RestoreFormPosition(pfrmIn As Form) 　　Dim i As Long 　　If MaxForm > 0 Then 　　For i = 0 To (MaxForm - 1) 　　　If FormRecord(i).Name = pfrmIn.Name Then 　　　　If FormRecord(i).Top < 0 Then 　　　　　pfrmIn.WindowState = 2 　　　　ElseIf FormRecord(i).Top < 30000 Then 　　　　　pfrmIn.WindowState = 0 　　　　　pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height 　　　　Else 　　　　　pfrmIn.WindowState = 1 　　　　End If 　　　　　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(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0) 　　End Sub

评论