怎样利用编写控件的方式实现:在窗体改变大小时可自动按比例改变窗体上所有控件大小及位置

Question

方法是有的但不推荐使用
因为等比缩放的效果是最差的最好是在ReSize事件中手动设置控件的坐标
虽然有点麻烦
但我认为友好的界面才是更重要的

Answer 1

定义全局变量保存初始化时的窗体宽和高，在ReSize事件里用for each x in Form改变每个控件的位置和大小

Answer 2

Option Explicit
Dim OldX As Integer, OldY As Integer, Down As Boolean
Private FormOldWidth As Long
 
Private FormOldHeight As Long
   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
    On Error GoTo 0
End Sub
Public Sub ResizeForm(FormName As Form)
    Dim Pos(4) 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 4
           
            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
    On Error GoTo 0
End SubPrivate Sub Form_Load()    Call ResizeInit(Me)
End SubPrivate Sub Form_Resize()
    Call ResizeForm(Me)
End Sub

Answer 3

'建立一个类模块，代码如下：（类名为ControlAutoSize）
Option Explicit
Private nFormHeight      As Integer
Private nFormWidth       As Integer
Private nNumOfControls   As Integer
Private nTop()           As Integer
Private nLeft()          As Integer
Private nHeight()        As Integer
Private nWidth()         As Integer
Private nFontSize()      As Integer
Private nRightMargin()   As Integer
Private bFirstTime       As Boolean
Private txtH             As Double
'--------------------------------------------------------------------------------Sub Init(frm As Form, Optional MDIid As Boolean, Optional nWindState As Variant)
Dim i          As Integer
Dim bWinMax    As Boolean
bWinMax = Not IsMissing(nWindState)
If MDIid = True Then
    nFormHeight = 9000
    nFormWidth = 12000
Else
    nFormHeight = 8130
    nFormWidth = 10305
End If
nNumOfControls = frm.Controls.Count - 1
bFirstTime = True
ReDim nTop(nNumOfControls)
ReDim nLeft(nNumOfControls)
ReDim nHeight(nNumOfControls)
ReDim nWidth(nNumOfControls)
ReDim nFontSize(nNumOfControls)
ReDim nRightMargin(nNumOfControls)
On Error Resume Next
For i = 0 To nNumOfControls
    If TypeOf frm.Controls(i) Is Line Then
        nTop(i) = frm.Controls(i).Y1
        nLeft(i) = frm.Controls(i).X1
        nHeight(i) = frm.Controls(i).Y2
        nWidth(i) = frm.Controls(i).X2
    ElseIf TypeOf frm.Controls(i) Is TextBox Then
        nTop(i) = frm.Controls(i).Top
        nLeft(i) = frm.Controls(i).Left
        nHeight(i) = frm.Controls(i).Height
        nWidth(i) = frm.Controls(i).Width
        nFontSize(i) = frm.FontSize
        nRightMargin(i) = frm.Controls(i).RightMargin
        txtH = nHeight(i)
    Else
        nTop(i) = frm.Controls(i).Top
        nLeft(i) = frm.Controls(i).Left
        nHeight(i) = frm.Controls(i).Height
        nWidth(i) = frm.Controls(i).Width
        nFontSize(i) = frm.FontSize
        nRightMargin(i) = frm.Controls(i).RightMargin
    End If
NextIf MDIid = True Then
    frm.Height = Screen.Height
    frm.Width = Screen.Width
Else
    frm.Height = frm_Sys_Main.Height - frm_Sys_Main.tbToolBar.Top - frm_Sys_Main.tbToolBar.Height - frm_Sys_Main.sbStatusBar.Height
    frm.Width = frm_Sys_Main.Width - frm_Sys_Main.MainButt.Width
End If
bFirstTime = True
End Sub'--------------------------------------------------------------------------------
Sub FormResize(frm As Form, Optional MDITofF As Boolean)
Dim i             As Integer
Dim nCaptionSize  As Integer
Dim dRatioX       As Double
Dim dRatioY       As Double
Dim nSaveRedraw   As Long
Dim txtnh         As Double
On Error Resume Next
nSaveRedraw = frm.AutoRedraw
frm.AutoRedraw = True
If bFirstTime Then
    bFirstTime = False
    Exit Sub
End If
If frm.Height < nFormHeight / 2 Then
    frm.Height = nFormHeight / 2
End If
If frm.Width < nFormWidth / 2 Then
    frm.Width = nFormWidth / 2
End IfnCaptionSize = 400
nCaptionSize = Int(nFontSize(i) / dRatioX) + Int(nFontSize(i) / dRatioX) Mod 2
dRatioY = 1# * (nFormHeight - nCaptionSize) _
/ (frm.Height - nCaptionSize)
dRatioX = 1# * nFormWidth / frm.Width
If Not MDITofF = True Then
    On Error Resume Next
    For i = 0 To nNumOfControls
        If TypeOf frm.Controls(i) Is TextBox Then
            frm.Controls(i).Height = Int(nHeight(i) / dRatioY)
            txtnh = frm.Controls(i).Height - txtH
            Exit For
        End If
    Next
End If
On Error Resume Next
For i = 0 To nNumOfControls
    If TypeOf frm.Controls(i) Is Line Then
        frm.Controls(i).Y1 = Int(nTop(i) / dRatioY) + 25
        frm.Controls(i).X1 = Int(nLeft(i) / dRatioX)
        frm.Controls(i).Y2 = Int(nHeight(i) / dRatioY) + 25
        frm.Controls(i).X2 = Int(nWidth(i) / dRatioX)
    Else
        frm.Controls(i).Top = Int(nTop(i) / dRatioY) - 25
        frm.Controls(i).Left = Int(nLeft(i) / dRatioX)
        frm.Controls(i).Height = Int(nHeight(i) / dRatioY)
        frm.Controls(i).Width = Int(nWidth(i) / dRatioX)
        frm.Controls(i).FontSize = nFontSize(i) + IIf(((nFontSize(i) / dRatioX - nFontSize(i)) / 2) - Int((nFontSize(i) / dRatioX - nFontSize(i)) / 2) = 0, (nFontSize(i) / dRatioX - nFontSize(i)) / 2, Int((nFontSize(i) / dRatioX - nFontSize(i)) / 2) + 1)
        frm.Controls(i).RightMargin = Int(nRightMargin(i) / dRatioY)
    End If
Next
frm.AutoRedraw = nSaveRedraw
End Sub'使用如下：
'在窗体中定义类： 
Private autor As New ControlAutoSize'在From_load过程中加入 
     autor.Init Me
'在Form_Resize过程中加入 
    autor.FormResize Me
'这样就一切OK了，不但控件改变了，连线条，字体也改了,是不是很好。