请问随窗体变化自动改变控件大小代码怎么写?

[自由之眼]

我写了一段,但不成功,各位高手有谁写过,帮忙看看,谢谢.
Option Explicit
Private M_FormHight As Integer '记录窗体高度
Private M_FormWide As Integer '记录窗体宽度
Private M_NumControls As Integer '记录窗体中控件总数

Private Type M_FormPropertySize
M_FTop As Integer '存储窗体中所有控件的相对高度
M_FLeft As Integer '存储窗体中所有控件的相对左偏移
M_FWide As Integer '存储窗体中所有控件的控件宽
M_FHight As Integer '存储窗体中所有控件的高度
M_FRightMargin As Integer '存储窗体中所有控件的页边距
M_FFontSize As Integer '存储窗体中所有控件的字体大小
End Type
Private M_FControlSize() As M_FormPropertySize '定义一个控件类型

Public Sub M_Init(M_Form As Form) '对窗体的性质进行初始化
Dim i As Integer '计数器
On Error GoTo ine
If M_Form.WindowState = 1 Then '如果窗体最小化,什么也不做
GoTo inerr
End If
'M_Form.WindowState = 2 '先最大化窗体
M_FormHight = M_Form.Height '得到窗体高度
M_FormWide = M_Form.Width '得到窗体宽度
M_NumControls = M_Form.Controls.Count '得到窗体上控件的总数

ReDim M_FControlSize(M_NumControls + 1) '定义窗体中控件类型的个数
On Error Resume Next
For i = 1 To M_NumControls '为窗体属性结构数组赋值
If TypeOf M_Form.Controls(i) Is Line Then
M_FControlSize(i).M_FTop = M_Form.Controls(i).Y1
M_FControlSize(i).M_FLeft = M_Form.Controls(i).X1
M_FControlSize(i).M_FWide = M_Form.Controls(i).X2
M_FControlSize(i).M_FHight = M_Form.Controls(i).Y2
'M_FControlSize(i).M_FFontSize = M_Form.Controls(i).FontSize
Else
M_FControlSize(i).M_FTop = M_Form.Controls(i).Top
M_FControlSize(i).M_FLeft = M_Form.Controls(i).Left
M_FControlSize(i).M_FWide = M_Form.Controls(i).Width
M_FControlSize(i).M_FHight = M_Form.Controls(i).hight
M_FControlSize(i).M_FFontSize = M_Form.Controls(i).FontSize
M_FControlSize(i).M_FRightMargin = M_Form.Controls.RightMargin
End If
Next i

GoTo inerr '无错跳出循环
ine:
MsgBox Err.Description, , "错误信息"
inerr:
End Sub

Public Sub M_FormResize(M_Form As Form)
Dim i As Integer
Dim M_X As Integer '横向缩放比例
Dim M_Y As Integer '纵向缩放比例
On Error GoTo ine
If M_Form.WindowState = 1 Then '如果窗体最小化,什么也不做
GoTo inerr
End If
'M_FormHight = M_Form.Height '得到窗体高度
'M_FormWide = M_Form.Width '得到窗体高度
M_Form.AutoRedraw = True '允许窗体控件重画

If M_Form.Height < M_FormHight / 2 Then
M_Form.Height = M_FormHight / 2 '自动缩放到原来的1/2
End If
If M_Form.Width < M_FormWide / 2 Then
M_Form.Width = M_FormWide / 2 '自动缩放到原来的1/2
End If

'计算访缩比例
M_X = 1# * M_FormWide / M_Form.Width '得到宽比例
M_Y = 1# * M_FormHight / M_Form.Height '得到高比例
On Error Resume Next
For i = 1 To M_NumControls
If TypeOf M_Form.Controls(i) Is Line Then
M_Form.Controls(i).Top = Int(M_FControlSize(i).M_FTop / M_Y)
M_Form.Controls(i).Left = Int(M_FControlSize(i).M_FLeft / M_X)
M_Form.Controls(i).Width = Int(M_FControlSize(i).M_FWide / M_X)
M_Form.Controls(i).hight = Int(M_FControlSize(i).M_FHight / M_Y)
Else
M_Form.Controls(i).Top = Int(M_FControlSize(i).M_FTop / M_Y)
M_Form.Controls(i).Left = Int(M_FControlSize(i).M_FLeft / M_X)
M_Form.Controls(i).Width = Int(M_FControlSize(i).M_FWide / M_X)
M_Form.Controls(i).hight = Int(M_FControlSize(i).M_FHight / M_Y)
M_Form.Controls(i).FontSize = (Int(M_FControlSize(i).M_FFontSize / M_X) + Int(M_FControlSize(i).M_FFontSize / M_Y)) / 2
M_Form.Controls(i).RightMargin = Int(M_FControlSize(i).M_FRightMargin / M_Y)
End If
Next i

GoTo inerr
ine:
MsgBox Err.Description, , "错误信息"
inerr:
End Sub

[heimayi]

这只能靠你自己写了！
一个人有一个人的方法！
我认为挺简单的。
其实就是设置WIDTH，HEIGHT，LEFT。TOP属性！

窗口与控件的这些属性比例！
放在RESIZE里！

[YHeng]

使用控件的move方法！！！！！！

[griefforyou]

Option Explicit
Private InitWidth As Long ' Form 的原始大小
Private InitHeight As Long

Private Sub Form_Load()
InitWidth = ScaleWidth
InitHeight = ScaleHeight
Dim Ctl As Control
' 記錄每個 Control 的原始位置、大小、字型大小, 放在 Tag 屬性中
On Error Resume Next '確保left, top, width, height, Tag屬性沒有全有的Control
For Each Ctl In Me '也能正常執行
Ctl.Tag = Ctl.Left & " " & Ctl.Top & " " & Ctl.Width & " " & Ctl.Height & " "
Ctl.Tag = Ctl.Tag & Ctl.FontSize & " "
Next Ctl
On Error GoTo 0
End Sub

Private Sub Form_Resize()
Dim D(4) As Double
Dim I As Long
Dim TempPos As Long
Dim StartPos As Long
Dim Ctl As Control
Dim TempVisible As Boolean
Dim ScaleX As Double
Dim ScaleY As Double

ScaleX = ScaleWidth / InitWidth
ScaleY = ScaleHeight / InitHeight
On Error Resume Next
For Each Ctl In Me
TempVisible = Ctl.Visible
Ctl.Visible = False
StartPos = 1
' 讀取 Control 的原始位置、大小、字型大小
For I = 0 To 4
TempPos = InStr(StartPos, Ctl.Tag, " ", vbTextCompare)
If TempPos > 0 Then
D(I) = Mid(Ctl.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
D(I) = 0
End If
' 根據比例設定 Control 的位置、大小、字型大小
Ctl.Move D(0) * ScaleX, D(1) * ScaleY, D(2) * ScaleX, D(3) * ScaleY
'Ctl.Width = D(2) * ScaleX
'Ctl.Height = D(3) * ScaleY
If ScaleX < ScaleY Then
Ctl.FontSize = D(4) * ScaleX
Else
Ctl.FontSize = D(4) * ScaleY
End If
Next I
Ctl.Visible = TempVisible
Next Ctl
On Error GoTo 0
End Sub

[shawls]

控件随窗体大小而变化

'当窗体大小改变时，如何动态的改变控件的大小是许多VB程序员头痛的
'事。有的人设置窗体Resizable但却不改变控件的大小；有的人则根据控件的
'绝对位置与窗口大小相加减的办法来重新定位控件与改变大小，这种办法比
'较繁琐，且不可重用；当然也有人则限定窗口干脆不让改变。
'下面给出一个一劳永逸的办法，源程序如下:

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


以上代码来自： SourceCode Explorer(源代码数据库)
复制时间： 2002-07-30 13:56:14
当前版本： 1.0.718
作者： Shawls
个人主页： Http://Shawls.Yeah.Net
E-Mail： [e-mail]
QQ： 9181729

[lily0000000]

private sub form_resize()
command1.height=screen.height/50
command1.width=screen.width/50
end sub

象这样用screen.height和screen.width来确定控件大小的方法就可以实现控件大小随着窗体的大小而改变

[自由之眼]

谢谢大家的帮助，我的代码问题找到了，解决了。谢谢。
完整代码如下：
Option Explicit
Private M_FormHight As Integer '记录窗体高度
Private M_FormWide As Integer '记录窗体宽度
Private M_NumControls As Integer '记录窗体中控件总数

Private Type M_FormPropertySize
M_FTop As Integer '存储窗体中所有控件的相对高度
M_FLeft As Integer '存储窗体中所有控件的相对左偏移
M_FWide As Integer '存储窗体中所有控件的控件宽
M_FHight As Integer '存储窗体中所有控件的高度
M_FRightMargin As Integer '存储窗体中所有控件的页边距
M_FFontSize As Integer '存储窗体中所有控件的字体大小
End Type
Private M_FControlSize() As M_FormPropertySize '定义一个控件类型

Public Sub M_Init(M_Form As Form) '对窗体的性质进行初始化
Dim i As Integer '计数器
On Error GoTo ine
If M_Form.WindowState = 1 Then '如果窗体最小化,什么也不做
GoTo inerr
End If
'M_Form.WindowState = 2 '先最大化窗体
M_FormHight = M_Form.Height '得到窗体高度
M_FormWide = M_Form.Width '得到窗体宽度
M_NumControls = M_Form.Controls.count '得到窗体上控件的总数

ReDim M_FControlSize(M_NumControls + 1) '定义窗体中控件类型的个数
On Error Resume Next
For i = 1 To M_NumControls '为窗体属性结构数组赋值
If TypeOf M_Form.Controls(i - 1) Is Line Then
M_FControlSize(i).M_FTop = M_Form.Controls(i - 1).Y1
M_FControlSize(i).M_FLeft = M_Form.Controls(i - 1).X1
M_FControlSize(i).M_FWide = M_Form.Controls(i - 1).X2
M_FControlSize(i).M_FHight = M_Form.Controls(i - 1).Y2
'M_FControlSize(i).M_FFontSize = M_Form.Controls(i).FontSize
Else
M_FControlSize(i).M_FTop = M_Form.Controls(i - 1).top
M_FControlSize(i).M_FLeft = M_Form.Controls(i - 1).left
M_FControlSize(i).M_FWide = M_Form.Controls(i - 1).Width
M_FControlSize(i).M_FHight = M_Form.Controls(i - 1).Height
M_FControlSize(i).M_FFontSize = M_Form.Controls(i - 1).FontSize
M_FControlSize(i).M_FRightMargin = M_Form.Controls(i - 1).RightMargin
End If
Next i

GoTo inerr '无错跳出循环
ine:
MsgBox Err.Description, , "错误信息"
inerr:
End Sub

Public Sub M_FormResize(M_Form As Form)
Dim i As Integer
Dim M_X As Single '横向缩放比例
Dim M_Y As Single '纵向缩放比例
On Error GoTo ine
If M_Form.WindowState = 1 Then '如果窗体最小化,什么也不做
GoTo inerr
End If
'M_FormHight = M_Form.Height '得到窗体高度
'M_FormWide = M_Form.Width '得到窗体高度
M_Form.AutoRedraw = True '允许窗体控件重画

If M_Form.Height < M_FormHight / 2 Then
M_Form.Height = M_FormHight / 2 '自动缩放到原来的1/2
End If
If M_Form.Width < M_FormWide / 2 Then
M_Form.Width = M_FormWide / 2 '自动缩放到原来的1/2
End If

'计算访缩比例
M_X = 1# * M_FormWide / M_Form.Width '得到宽比例
M_Y = 1# * M_FormHight / M_Form.Height '得到高比例
On Error Resume Next
For i = 1 To M_NumControls
If TypeOf M_Form.Controls(i - 1) Is Line Then
M_Form.Controls(i - 1).top = Int(M_FControlSize(i).M_FTop / M_Y)
M_Form.Controls(i - 1).left = Int(M_FControlSize(i).M_FLeft / M_X)
M_Form.Controls(i - 1).Width = Int(M_FControlSize(i).M_FWide / M_X)
M_Form.Controls(i - 1).hight = Int(M_FControlSize(i).M_FHight / M_Y)
Else
M_Form.Controls(i - 1).top = Int(M_FControlSize(i).M_FTop / M_Y)
M_Form.Controls(i - 1).left = Int(M_FControlSize(i).M_FLeft / M_X)
M_Form.Controls(i - 1).Width = Int(M_FControlSize(i).M_FWide / M_X)
M_Form.Controls(i - 1).Height = Int(M_FControlSize(i).M_FHight / M_Y)
M_Form.Controls(i - 1).FontSize = (Int(M_FControlSize(i).M_FFontSize / M_X) + Int(M_FControlSize(i).M_FFontSize / M_Y)) / 2
M_Form.Controls(i - 1).RightMargin = Int(M_FControlSize(i).M_FRightMargin / M_Y)
End If
Next i

GoTo inerr
ine:
MsgBox Err.Description, , "错误信息"
inerr:
End Sub

[yidaoxiwei]

这个问题很棘手，怎么算都会有误差，办法只有载入的时候一种状态，然后最大化一种状态，