VB6中窗体控件随窗体缩放自动适应尺寸

Question

各位高手，菜鸟有一个小问题，就是我想让窗体内的控件随窗体的缩放自动适应尺寸，怎样才可以做到呀，拜谢各位了！

Answer 1

Private Sub Form_Resize()
  Dim H, i As Integer  On Error Resume Next  Resize_ALL MeEnd SubPrivate Sub Form_Load()  Dim lRet As Long
  Dim apiRECT As RECT
  lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)
  If lRet Then
     Me.Width = apiRECT.Right / 72 * 1440 - 180
     Me.Width = Me.Width - 180
     Me.Height = apiRECT.Bottom / 72 * 1440 - 180
     Me.Height = Me.Height - 1620
  End If
  
'+++2006/11/10  E
End Sub下面的代码放在模块里面Option Explicit'********************************************
'2006/11/9    
'********************************************
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 LongEnd TypePrivate FormRecord() As ctrObjPrivate ControlRecord() As ctrObjPrivate bRunning As BooleanPrivate MaxForm As LongPrivate MaxControl As LongPrivate Const WM_NCLBUTTONDOWN = &HA1Private 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 LongPublic Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Public Const SPI_GETWORKAREA = 48
Public Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" _
    (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, _
    ByVal fuWinIni As Long) As LongFunction ActualPos(plLeft As Long) As Long    
    If 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 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(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 FormControlEnd 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).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
    
    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 + 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    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 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

Answer 2

Private Sub Form_Resize()
  Dim H, i As Integer  On Error Resume Next  Resize_ALL MeEnd SubPrivate Sub Form_Load()  Dim lRet As Long
  Dim apiRECT As RECT
  lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)
  If lRet Then
     Me.Width = apiRECT.Right / 72 * 1440 - 180
     Me.Width = Me.Width - 180
     Me.Height = apiRECT.Bottom / 72 * 1440 - 180
     Me.Height = Me.Height - 1620
  End If
  
'+++2006/11/10  E
End Sub下面的代码放在模块里面Option Explicit'********************************************
'2006/11/9    
'********************************************
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 LongEnd TypePrivate FormRecord() As ctrObjPrivate ControlRecord() As ctrObjPrivate bRunning As BooleanPrivate MaxForm As LongPrivate MaxControl As LongPrivate Const WM_NCLBUTTONDOWN = &HA1Private 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 LongPublic Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Public Const SPI_GETWORKAREA = 48
Public Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" _
    (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, _
    ByVal fuWinIni As Long) As LongFunction ActualPos(plLeft As Long) As Long    
    If 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 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(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 FormControlEnd 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).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
    
    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 + 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    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 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

Answer 3

Resize_ALL   Me ？

Answer 4

给我自己试过的一个简单例子，不知道是否适合你！'控件大小随窗体变化自适应，主要是使用了Move方法。Option ExplicitPrivate Sub Form_Resize()
   Text1.Move 0, 0, ScaleWidth, ScaleHeight / 3
   Command1.Move 0, (Text1.Height), ScaleWidth / 2, ScaleHeight / 3
End Sub