请教如何实现vb程序中控件随着窗口大小的改变而改变，即保持原来的比例？

[lpzwm]

谢谢！在线等

[viena]

写个函数

[outorenter]

'在调用ResizeForm前先调用本函数 如form_load() 用Call ResizeInit(Me) Form_Resize() 时Call ResizeForm(Me)
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

[daisy8675]

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
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
'读取控件的原始位置与大小

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
On Error GoTo 0
End Sub

Private Sub Form_Load()
Call ResizeInit(Me) '在装入时必须加入
End Sub

Private Sub Form_Resize()
Call ResizeForm(Me) '控件随之改变
End Sub

方法二

　　WINDOWS下的窗口一般都可以通过鼠标拖动来扩 大，有些时候我们需要控制窗口的比例不变，以防窗口比例失调时造成界面的不协调。要做 到这一点，可以利用API函数CallWindwosProc，当得到用户调整窗口的消息时，判断X或Y方 向上的比例是否和原来的比例一样，如果不一样，则调整为一样。下面是一个例子。
Private Sub Command1_Click()
UnloadMe
EndSub

Private Sub Form_Load()
OldWindowProc=SetWindowLong(hwnd,GWL_WNDPROC,AddressOf NewWindowProc)
EndSub

模块中：

Public OldWindowProc As Long
声明API函数如下：
Declare Function CallWindowProc Lib"user32"Alias"CallWindowProcA"(ByVal lpPrevWndFunc As
Long,ByVal hwnd As Long,ByValmsg As Long,ByVal wParam As Long,lParam As WINDOWPOS)As Long
Declare Function SetWindowLong Lib "user32"Alias"SetWindowLongA" (alhwnd As
Long,ByValnIndex As Long,ByVal dwNewLong As Long)As Long

Const GWL_WNDPROC=-4
定义一个窗口位置数据类型
Type WINDOWPOS
hwnd As Long
hWndInsertAfter As Long
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type
Const WM_WINDOWPOSCHANGING=&H46
Const WM_WINDOWPOSCHANGED=&H47
处理窗口变化的函数
PublicFunctionNewWindowProc(ByVal hwnd As Long,ByVal msg As Long,ByVal wParam As
Long,lParam As WINDOWPOS)As Long
Static done_before As Boolean
Static aspect As Single
Dim new_aspect As Single

If msg=WM_WINDOWPOSCHANGING Then
If lParam.cy>0 Then
保存原来的比例
If Notdone_before Then
aspect=lParam.cx/lParam.cy
done_before=True
End If

new_aspect=lParam.cx/lParam.cy
If new_aspect>aspect Then
lParam.cy=lParam.cx/aspect
Else
lParam.cx=aspect*lParam.cy
End If
End If
End If

NewWindowProc=CallWindowProc
(OldWindowProc,hwnd,msg,wParam,lParam)

End Function

[leolan]

http://www.yesky.com/SoftChannel/72342371928637440/20040504/1794267.shtml