VB中控件大小随窗体大小变化

【 tulaoshi.com - 编程语言 】

　　有时窗体变化后，如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦，下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。

　　在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