我的以下这段代码为实现窗体控件随窗体的变化而按比例变化,
为什么只有在最大化是可以实现,
其它变化时却达不到效果?private Sub Form_Load()
 fh1 = Form1.Height
fw1 = Form1.WidthEnd SubPrivate Sub Form_Resize()
Dim scalex, scaley As Integer
Dim fw2, fh2 As Integer
Dim control As VariantIf Form1.WindowState = 1 Then Exit Subfw2 = Form1.Width
fh2 = Form1.Heightscalex = fw2 / fw1
scaley = fh2 / fh1 
For Each control In Form1.Controls
If (Val(fh2) < fh1) Or (Val(fh2) > fh1) Thencontrol.Height = control.Height * scaleycontrol.Top = control.Top * scaleyEnd IfIf (Val(fw2) < fw1) Or (Val(fw2) > fw1) Thencontrol.Width = control.Width * scalexcontrol.Left = control.Left * scalexEnd IfNext controlfw1 = Form1.Width
fh1 = Form1.HeightEnd Sub

解决方案 »

  1.   

    在scalex = fw2 / fw1
      scaley = fh2 / fh1
    之后再加上下述代码看看:
    fw1 = fw2
    fh1 = fh2
      

  2.   

    If Form1.WindowState = 1 Then Exit Sub
    把这一句去掉.另外想说一句.
    vb中这样调整大小并不是对所有控件都有用的. 比如说combobox
      

  3.   

    明白了你的意思,你可能没有刷新
    这是我的代码(写成控件):Option Explicit' if True, also fonts are resized
    Public ResizeFont As Boolean
    ' if True, form's height/width ratio is preserved
    Public KeepRatio As BooleanPrivate Type TControlInfo
        ctrl As Control
        Left As Single
        Top As Single
        Width As Single
        Height As Single
        FontSize As Single
        FontName As String
    End Type' this array holds the original position
    ' and size of all controls on parent form
    Dim Controls() As TControlInfo' a reference to the parent form
    Private WithEvents ParentForm As Form
    ' parent form's size at load time
    Private ParentWidth As Single
    Private ParentHeight As Single
    ' ratio of original height/width
    Private HeightWidthRatio As SinglePrivate Sub ParentForm_Load()
        ' the ParentWidth variable works as a flag
        ParentWidth = 0
        ' save original ratio
        HeightWidthRatio = ParentForm.Height / ParentForm.Width
    End SubPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)
        If Ambient.UserMode = False Then Exit Sub
        ' store a reference to the parent form and
        ' start receiving events
        Set ParentForm = Parent
    End SubPrivate Sub UserControl_Resize()
        ' refuse to resize
        Image1.Move 0, 0
        UserControl.Width = Image1.Width
        UserControl.Height = Image1.Height
    End Sub' trap the parent form's Resize event
    ' this include the very first resize event
    ' that occurs soon after form's loadPrivate Sub ParentForm_Resize()
        If ParentWidth = 0 Then
            Rebuild
        Else
            Refresh
        End If
    End Sub' save size and position of all controls on parent form
    ' you should manually invoke this method each time you add a new control
    ' to the form (through Load method of a control array)Sub Rebuild()
        ' rebuild the internal table
        Dim i As Integer, ctrl As Control
        ' this is necessary for controls that don't support
        ' all properties (e.g. Timer controls)
        On Error Resume Next
        
        If Ambient.UserMode = False Then Exit Sub
        
        ' save a reference to the parent form, and its initial size
        Set ParentForm = UserControl.Parent
        ParentWidth = ParentForm.ScaleWidth
        ParentHeight = ParentForm.ScaleHeight
        
        ' read the position of all controls on the parent form
        ReDim Controls(ParentForm.Controls.Count - 1) As TControlInfo
        
        For i = 0 To ParentForm.Controls.Count - 1
            Set ctrl = ParentForm.Controls(i)
            With Controls(i)
                Set .ctrl = ctrl
                .Left = ctrl.Left
                .Top = ctrl.Top
                .Width = ctrl.Width
                .Height = ctrl.Height
                .FontSize = ctrl.Font.Size
                .FontName = ctrl.Font.Name
            End With
        Next
    End Sub' update size and position of controls on parent formSub Refresh()
        Dim i As Integer, ctrl As Control
        Dim widthFactor As Single, heightFactor As Single
        Dim minFactor As Single
        
        ' inhibits recursive calls if KeepRatio = True
        Static executing As Boolean
        If executing Then Exit Sub
        
        If Ambient.UserMode = False Then Exit Sub
        
       If KeepRatio Then
          executing = True
          ' we must keep original ratio
          If ParentForm.WindowState = vbNormal Then
             ParentForm.Height = HeightWidthRatio * ParentForm.Width
          End If
          executing = False
       End If
        
        ' this is necessary for controls that don't support
        ' all properties (e.g. Timer controls)
        On Error Resume Next    widthFactor = ParentForm.ScaleWidth / ParentWidth
        heightFactor = ParentForm.ScaleHeight / ParentHeight
        ' take the lesser of the two
        If widthFactor < heightFactor Then
            minFactor = widthFactor
        Else
            minFactor = heightFactor
        End If
        
       ' this is a regular resize
       For i = 0 To UBound(Controls)
          With Controls(i)
             ' the change of font must occur *before* the resizing
             ' to account for companion scrollbar of listbox
             ' and other similar controls
             If ResizeFont Then
                '.ctrl.Font.Size = .FontSize * minFactor
                If (.FontSize * minFactor) < 8 Then
                   .ctrl.Font.Name = "Small Fonts"
                   If (.FontSize * minFactor) > 7 Then
                      .ctrl.Font.Size = 7
                   Else
                      .ctrl.Font.Size = .FontSize * minFactor
                   End If
                ElseIf .ctrl.Font.Name <> .FontName Then
                   .ctrl.Font.Name = .FontName
                   .ctrl.Font.Size = .FontSize * minFactor
                Else
                   .ctrl.Font.Size = .FontSize * minFactor
                End If
             End If
             ' move and resize the controls - we can't use a Move
             ' method because some controls do not support the change
             ' of all the four properties (e.g. Height with comboboxes)
             If .ctrl.Left < 0 Then
                .ctrl.Left = ((.ctrl.Left + 75000) * widthFactor) - 75000
             ElseIf .Left < 0 Then
                .ctrl.Left = (.Left + 75000) * widthFactor
             Else
                .ctrl.Left = .Left * widthFactor
             End If
             .ctrl.Top = .Top * heightFactor
             .ctrl.Width = .Width * widthFactor
             .ctrl.Height = .Height * heightFactor
          End With
       Next
       
    End Sub
      

  4.   

    http://expert.csdn.net/Expert/topic/1710/1710828.xml?temp=.2830927
    其中freehorse_1981() 的代码可看,如下:
    '保存窗体的原始宽度
    Private FormOldWidth As Long
    '保存窗体的原始高度
    Private FormOldHeight As Long
    '在调用ResizeForm前先调用本函数
    Public Sub ResizeInit(FormName As Form)
        Dim Obj As Control
        FormOldWidth = FormName.ScaleWidth
        FormOldHeight = FormName.ScaleHeight
        On Error Resume Next
        '保存
        For Each Obj In FormName
            Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
        Next Obj
    End Sub'按比例改变表单内各元件的大小,
    Public Sub ResizeForm(FormName As Form)
        Dim Pos(3) As Double
        Dim I As Long, TempPos As Long, StartPos As Long
        Dim Obj As Control
        Dim ScaleX As Double, ScaleY As Double
        '保存窗体宽度缩放比例
        ScaleX = FormName.ScaleWidth / FormOldWidth
        '保存窗体高度缩放比例
        ScaleY = FormName.ScaleHeight / FormOldHeight
        On Error Resume Next
        For Each Obj In FormName
            StartPos = 1
            For I = 0 To 3
                '读取控件的原始位置与大小
                TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
                If TempPos > 0 Then
                    Pos(I) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
                    StartPos = TempPos + 1
                Else
                    Pos(I) = 0
                End If
                 '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
                 Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
            Next I
        Next Obj
    End SubPrivate Sub Form_Load()
        Call ResizeInit(Me) '在程序装入时必须加入
    End SubPrivate Sub Form_Resize()
        Call ResizeForm(Me) '确保窗体改变时控件随之改变
    End Sub
      

  5.   

    另外,你的原代码中的
    Dim scalex, scaley As Integer
    有问题,应改用其它名称的变量,且应定义为long型,如下:
       dim ssx as long,ssy as long
      

  6.   

    应该是private Sub Form_Resize事件吧