求救控件大小随窗口大小改变急啊 - VB6论坛

得分:0

由于我们设计窗体时，安排的各个控件的大小和位置是固定的，如果在程序运行过程中窗体大小发生了变化，就会造成控件大小与窗体大小不成比例。

程序实现的基本思路是在窗体大小改变前取得窗体的ScaleWidth、ScaleHeight以及窗体内各个控件的Left、Top、Width、Height属性，并把它们保存起来。当窗体的大小被改变时，用窗体的新ScaleWidth、ScaleHeight与改变前的值相比，得到一个缩放比例，然后把这个比例与控件的Left、Top、Width、Height属性的乘积作为新的控件位置和大小，重画这些控件。下面是实现的步骤：

　　　1、得到原有窗体ScaleWidth、ScaleHeight属性：
　　　FormOldWidth = FormName.ScaleWidth
　　　FormOldHeight = FormName.ScaleHeight
　　　2、取得各个控件的Left、Top、Width、Height属性并把它们存放在控件的Tag属性中：
　　　Dim Obj As Control　　　'Control是一个对象，表示所有 Visual Basic 内部控件的类名
　　　For Each Obj In FormName
　　　'Tag返回或设置一个表达式用来存储程序中需要的额外数据。
　　　Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
　　　Next Obj
　　　3、当窗体大小改变时计算缩放比例：
　　　'保存窗体宽度缩放比例
　　　ScaleX = FormName.ScaleWidth / FormOldWidth
　　　'保存窗体高度缩放比例
　　　ScaleY = FormName.ScaleHeight / FormOldHeight
　　　4、读取控件的原始位置与大小，并根据缩放比例重新安置控件：
　　　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 Obj

　　好了这样我们就不必担心窗体内的控件大小位置不成比例了，由于程序可以自动改变所有控件的大小，只要是窗体内的控件，大小都随之而变化

'--------------------------------------
' 自动改变控件大小
'--------------------------------------
'本例实现一个控件大小随窗体大小改变而自动改变的文本编辑器

'以下为模块中的代码：
'-------------------------------------------
Option Explicit
'定义 FormOldWidth, FormOldHeight 为全局变量，这样其他模块才能调用它
Global FormOldWidth, FormOldHeight

'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)

'Control是一个对象，表示所有 Visual Basic 内部控件的类名。
'可以将一个变量标为 Control 对象，象引把控件放到窗体上的一样来引用它。例如：
'Dim C As Control
'Set C = Command1
Dim Obj As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
On Error Resume Next

'Each是一个关键字，作用是针对一个数组或集合中的每个元素，重复执行一组语句。
'语法
'For Each element In Group
For Each Obj In FormName
'Tag返回或设置一个表达式用来存储程序中需要的额外数据。
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0

End Sub

'按比例改变表单内各元件的大小，
'在调用ReSizeForm前先调用ReSizeInit函数
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
'InStr函数，返回 Variant (Long)，指定一字符串在另一字符串中最先出现的位置。语法:InStr([start, ]string1, string2[, compare])
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
'Mid函数，返回Variant (String)，其中包含字符串中指定数量的字符。语法：Mid(string, start[, length])
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If

'根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
'Move方法，用以移动 MDIForm、Form 或控件。语法:object.Move Left, Top, Width, Height
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY

Next i
Next Obj
On Error GoTo 0

End Sub

佛曰:\"前世的500次回眸才换来今生的一次擦肩而过\".我宁愿用来世的一次擦肩而过来换得今生的500次回眸.