窗体控件大小随窗体大小变化而变化

1、窗体控件大小随窗体大小变化而变化有时窗体变化后，如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦，下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小，如：Private Sub Form_Resize()Dim H, i As IntegerOn Error Resume NextResize_ALL Me 'Me是窗体名，Form1,Form2等等都可以End Sub在模块中添加以下代码：Public Type ctrObj Name As String Index As Long

2、 Parrent As String Top As Long Left As Long Height As Long Width As Long ScaleHeight As Long ScaleWidth As LongEnd TypePrivate FormRecord() As ctrObjPrivate ControlRecord() As ctrObjPrivate bRunning As BooleanPrivate MaxForm As LongPrivate MaxControl As LongPrivate Const WM_NCLBUTTONDOWN = &HA1P

3、rivate Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Declare Function ReleaseCapture Lib "USER32" () As LongFunction ActualPos(plLeft As Long) As Long If

4、 plLeft < 0 Then ActualPos = plLeft + 75000 Else ActualPos = plLeft End IfEnd FunctionFunction 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 IfEnd

5、 FunctionFunction 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(M

6、axForm).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.Na

7、me) End If Next FormControl End FunctionFunction 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).

8、Index = inControl.Index Then FindControl = i Exit Function End If On Error GoTo 0 End If End If Next iEnd FunctionFunction AddControl(inControl As Control, inName As String) As Long ReDim Preserve ControlRecord(MaxControl + 1) On Error Resume Next ControlRecord(MaxControl).Name = inControl.Name Cont

9、rolRecord(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).Wi

10、dth = 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 Ad

11、dControl = MaxControl MaxControl = MaxControl + 1End FunctionFunction 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).ScaleWidthEnd FunctionFunction PerHeight(pfrmIn As Form) As Double

12、Dim i As Long i = FindForm(pfrmIn) If i < 0 Then i = AddForm(pfrmIn) End If PerHeight = (pfrmIn.ScaleHeight * 100) FormRecord(i).ScaleHeightEnd FunctionPublic Sub ResizeControl(inControl As Control, pfrmIn As Form) On Error Resume Next Dim i As Long Dim widthfactor As Single, heightfactor As Sing

13、le 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)

14、.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)

15、- 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 i

16、nControl.Y2 = CLng(ControlRecord(i).Height * yRatio) 100) Else inControl.Move lLeft, lTop, lWidth, lHeight inControl.Move lLeft, lTop, lWidth inControl.Move lLeft, lTop End IfEnd SubPublic Sub ResizeForm(pfrmIn As Form) Dim FormControl As Control Dim isVisible As Boolean Dim StartX, StartY, MaxX, Ma

17、xY 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 I

18、f 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 = FormC

19、ontrol.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

20、 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.V

21、isible = 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 IfEnd SubPublic 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 A