VB中控件位置大小自动适应窗体变化的三种模式详解.doc代码是无需更改的。

第一种。

就是最实用的，就是所有控件的width和height按比例随窗体变化，位置也是当然是按比例哦。

控件的字体不变。

如下复制到代码：'改比例，字体不该。

最实用Option ExplicitPrivate FormOldWidth As Long '保存窗体的原始宽度Private FormOldHeight As Long '保存窗体的原始高度Private Sub Form_Load()Call ResizeInit(Me) '在程序装入时必须加入End SubPrivate Sub Form_Resize()Call ResizeForm(Me) '确保窗体改变时控件随之改变End Sub'在调用ResizeForm前先调用本函数Public Sub ResizeInit(FormName As Form)Dim Obj As ControlFormOldWidth = FormName.ScaleWidthFormOldHeight = FormName.ScaleHeightOn Error Resume NextFor Each Obj In FormNameObj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " " Next ObjOn Error GoTo 0End Sub'按比例改变表单内各元件的大小，在调用ReSizeForm前先调用ReSizeInit函数Public Sub ResizeForm(FormName As Form)Dim Pos(4) As DoubleDim i As Long, TempPos As Long, StartPos As LongDim Obj As ControlDim ScaleX As Double, ScaleY As DoubleScaleX = FormName.ScaleWidth / FormOldWidth '保存窗体宽度缩放比例ScaleY = FormName.ScaleHeight / FormOldHeight '保存窗体高度缩放比例On Error Resume NextFor Each Obj In FormNameStartPos = 1For i = 0 To 4'读取控件的原始位置与大小TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)If TempPos > 0 ThenPos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)StartPos = TempPos + 1ElsePos(i) = 0End If'根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY Next iNext ObjOn Error GoTo 0End Sub第二种，只位置就是控件的left和top随着变。

其他都不变。

如果变化大了不好看。

如下复制：Option ExplicitPrivate ObjOldWidth As Long '保存窗体的原始宽度Private ObjOldHeight As Long '保存窗体的原始高度Private ObjOldFont As Single '保存窗体的原始字体比Private Sub Form_Resize()'确保窗体改变时控件随之改变Call ResizeForm(Me)End SubPrivate Sub Form_Load()'在程序装入时必须加入Call ResizeInit(Me)End Sub' '在调用ResizeForm前先调用本函数Public Sub ResizeInit(FormName As Form)Dim Obj As ControlObjOldWidth = FormName.ScaleWidthObjOldHeight = FormName.ScaleHeightObjOldFont = FormName.Font.Size / ObjOldHeightOn Error Resume NextFor Each Obj In FormNameObj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "Next ObjOn Error GoTo 0End Sub'按比例改变表单内各元件的大小，'在调用ReSizeForm前先调用ReSizeInit函数Public Sub ResizeForm(FormName As Form)Dim Pos(4) As DoubleDim i As Long, TempPos As Long, StartPos As LongDim Obj As ControlDim ScaleX As Double, ScaleY As DoubleScaleX = FormName.ScaleWidth / ObjOldWidth'保存窗体宽度缩放比例ScaleY = FormName.ScaleHeight / ObjOldHeight'保存窗体高度缩放比例On Error Resume NextFor Each Obj In FormNameStartPos = 1For i = 0 To 4'读取控件的原始位置与大小TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)If TempPos > 0 ThenPos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)StartPos = TempPos + 1ElsePos(i) = 0End If'根据控件的原始位置及窗体改变大'小的比例对控件重新定位与改变大小Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleYNext iNext ObjEnd Sub第三种，就是所有的都按比例。

包括大小。

字体，位置，就像放大镜的感觉。

复制如下：Option ExplicitPrivate ObjOldWidth As Long '保存窗体的原始宽度Private ObjOldHeight As Long '保存窗体的原始高度Private ObjOldFont As Single '保存窗体的原始字体比'窗体部分Private Sub Form_Resize()'确保窗体改变时控件随之改变Call ResizeForm(Me)End SubPrivate Sub Form_Load()'在程序装入时必须加入Call ResizeInit(Me)End Sub' '在调用ResizeForm前先调用本函数Public Sub ResizeInit(FormName As Form)Dim Obj As ControlObjOldWidth = FormName.ScaleWidthObjOldHeight = FormName.ScaleHeightObjOldFont = FormName.Font.Size / ObjOldHeightOn Error Resume NextFor Each Obj In FormNameObj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "Next ObjOn Error GoTo 0End Sub'按比例改变表单内各元件的大小，'在调用ReSizeForm前先调用ReSizeInit函数Public Sub ResizeForm(FormName As Form)Dim Pos(4) As DoubleDim i As Long, TempPos As Long, StartPos As LongDim Obj As ControlDim ScaleX As Double, ScaleY As DoubleScaleX = FormName.ScaleWidth / ObjOldWidth'保存窗体宽度缩放比例ScaleY = FormName.ScaleHeight / ObjOldHeight'保存窗体高度缩放比例On Error Resume NextFor Each Obj In FormNameStartPos = 1For i = 0 To 4'读取控件的原始位置与大小TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)If TempPos > 0 ThenPos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)StartPos = TempPos + 1ElsePos(i) = 0End If'根据控件的原始位置及窗体改变大'小的比例对控件重新定位与改变大小Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY Obj.Font.Size = ObjOldFont * FormName.ScaleHeightNext iNext ObjEnd Sub。