明辉手游网中心:是一个免费提供流行视频软件教程、在线学习分享的学习平台!

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

[摘要]有时窗体变化后,如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦,下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小,如:Private Sub Form_Resize()Dim H, i As...
有时窗体变化后,如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦,下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。

在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