Private Sub Form_Resize() If Me.WindowState = 0 Then Me.Height = 7755 Me.Width = 11700
Picture1.Top = 840 Picture1.Left = 0 Picture1.Width = Me.ScaleWidth Picture1.Height = Me.ScaleHeight - 975 - 240 End If If Me.WindowState = 2 Then Picture1.Top = 840 Picture1.Left = 0 Picture1.Width = Me.ScaleWidth Picture1.Height = Me.ScaleHeight - 975 - 240 Else End IfEnd Sub 我以前是这样整的 你看看 有用没. 但是你要是把东西用label空间输出时就有麻烦了 你要是跟着变的话就有可能显示不了了... 有人要是有更好的办法也告诉我.
按比例改变表单内各元件的大小: '以下代码写在标准模块中 Option Explicit 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 '在调试时如果出现除数为零错误,是因为没有设定form的初值,请双击form1然后再测试,这个问题绝对不会在编译好的程序中出现 If FormOldWidth = 0 Then '防止该错误的产生 Exit Sub End If 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'窗体代码: Option Explicit Private Sub Form_Load() ResizeInit Me End SubPrivate Sub Form_Resize() ResizeForm Me End Sub
除了用一个timer随时检测screen,我想不出其他办法能让他“自动”起来。
http://www.cowcow.us/wanglo/aspnet/200504/10292.html不知道对lz有没有帮助
If Me.WindowState = 0 Then
Me.Height = 7755
Me.Width = 11700
Picture1.Top = 840
Picture1.Left = 0
Picture1.Width = Me.ScaleWidth
Picture1.Height = Me.ScaleHeight - 975 - 240
End If
If Me.WindowState = 2 Then
Picture1.Top = 840
Picture1.Left = 0
Picture1.Width = Me.ScaleWidth
Picture1.Height = Me.ScaleHeight - 975 - 240
Else
End IfEnd Sub
我以前是这样整的 你看看 有用没.
但是你要是把东西用label空间输出时就有麻烦了 你要是跟着变的话就有可能显示不了了...
有人要是有更好的办法也告诉我.
'以下代码写在标准模块中
Option Explicit
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
'在调试时如果出现除数为零错误,是因为没有设定form的初值,请双击form1然后再测试,这个问题绝对不会在编译好的程序中出现
If FormOldWidth = 0 Then '防止该错误的产生
Exit Sub
End If
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'窗体代码:
Option Explicit
Private Sub Form_Load()
ResizeInit Me
End SubPrivate Sub Form_Resize()
ResizeForm Me
End Sub
Screen.Width / Screen.TwipsPerPixelX
Screen.Height / Screen.TwipsPerPixelX
在有些机器上,有时计算结果宽和高经常颠倒,例如本来是1024*768,而Screen.Width / Screen.TwipsPerPixelX的结果可能是768,建议如果使用以上公式计算时,根据两者的积来确定分辨率.
我试一试