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

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



　　在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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有