1,451
社区成员
发帖
与我相关
我的任务
分享如何使窗体中的所有控件随显示器的分辨率大小变化！！！！
我以前用vb作的程序（在800*600调试），现在我的分辨率是（1024*786），我如何该我的程序！！！！！！
谢谢 ！
谢谢 ！
...全文
请发表友善的回复…
发表回复
xxlroad 2002-06-24
- 打赏
- 举报
'******************************************************
'原作者：邓勇
'收集整理：小聪明 coolzm@sohu.com
'欢迎访问小聪明的主页VB版： http://coolzm.533.net
'******************************************************
'功能:：窗体大小改变时窗体内的控件大小也随之动态改变
'使用方法：
'在相应的窗体程序中加入如下语句：
'---------------------------------------------------
'Private Sub Form_Load()
' Call ResizeInit(Me) '在程序装入时必须加入
'End Sub
'Private Sub Form_Resize()
' Call ResizeForm(Me) '确保窗体改变时控件随之改变
'End Sub
'---------------------------------------------------
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
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
'效果不是很好 只对一般的有效果
'原作者：邓勇
'收集整理：小聪明 coolzm@sohu.com
'欢迎访问小聪明的主页VB版： http://coolzm.533.net
'******************************************************
'功能:：窗体大小改变时窗体内的控件大小也随之动态改变
'使用方法：
'在相应的窗体程序中加入如下语句：
'---------------------------------------------------
'Private Sub Form_Load()
' Call ResizeInit(Me) '在程序装入时必须加入
'End Sub
'Private Sub Form_Resize()
' Call ResizeForm(Me) '确保窗体改变时控件随之改变
'End Sub
'---------------------------------------------------
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
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
'效果不是很好 只对一般的有效果
jwing 2002-06-24
- 打赏
- 举报
我也试试,看看能不能实现!
Gulang68 2002-04-05
- 打赏
- 举报
'试试这个吧
Private InitWidth as Double
Private InitHeight as Double
Private Sub Form_Load()
InitWidth = Me.ScaleWidth
InitHeight = Me.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 = Me.ScaleWidth / InitWidth
ScaleY = Me.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
Private InitWidth as Double
Private InitHeight as Double
Private Sub Form_Load()
InitWidth = Me.ScaleWidth
InitHeight = Me.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 = Me.ScaleWidth / InitWidth
ScaleY = Me.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
lily0000000 2002-04-05
- 打赏
- 举报
可以用窗体大小的表达式来表示控件大小
如：
command1.height=screenheight/60
command1.width=screenheight/120
这样，控件大小就可以随着分辨率的大小而适应窗体大小了
如：
command1.height=screenheight/60
command1.width=screenheight/120
这样，控件大小就可以随着分辨率的大小而适应窗体大小了
Tsou 2002-04-04
- 打赏
- 举报
设计成一个控件就可以，如果需要源代码就告诉email(我的email:Tsouan@hotmail.com)
gump2000 2002-04-04
- 打赏
- 举报
别偷懒，您手动写的话只有这样了。
wqb 2002-04-04
- 打赏
- 举报
运行程序就把屏幕分辨率设为800X600,退出时再改回去 ：）
combread 2002-04-04
- 打赏
- 举报
zyl910(910：分儿，我来了！) ,我知道这样就行了.
要不然我怎么说这个例子很不好.
只不过说明一下,如果要保持控件的大小相对变化的话,应该怎样.
不过,若是全部控件的大小和位置都以Me.ScaleWidth来定位和控制大小,分辨率的问题也可以解决.
要不然我怎么说这个例子很不好.
只不过说明一下,如果要保持控件的大小相对变化的话,应该怎样.
不过,若是全部控件的大小和位置都以Me.ScaleWidth来定位和控制大小,分辨率的问题也可以解决.
zyl910 2002-04-03
- 打赏
- 举报
干吗有这么复杂？这样就行：
Command1.Width=Me.ScaleWidth/3
Command1.Width=Me.ScaleWidth/3
114 2002-04-03
- 打赏
- 举报
这样一来我的所用控件都要添加好多代码？
对页面比较少的话你的方法实行的，但是我的叶面太多，谢谢你
对页面比较少的话你的方法实行的，但是我的叶面太多，谢谢你
combread 2002-04-03
- 打赏
- 举报
比如,你有三个按钮在窗体上并排放置,要求刚好占满一个窗体的宽度
只是打个比方
^_^
当然这个例子并不好,只不过提供实例而已.
则可有代码:
Option Explicit
Private Sub Form_Load()
'''800*600时窗体宽度是12120twip
'''1024*768时窗体宽度是15480twip
'''则有以下代码
Dim I As Integer
I = Screen.Width / Screen.TwipsPerPixelX
Select Case I
Case 800 '''800*600
Command1.Left = 0
Command1.Width = 12120 / 3
Command2.Left = Command1.Left + Command1.Width
Command2.Width = 12120 / 3
Command3.Left = Command2.Left + Command2.Width
Command3.Width = 12120 / 3
Case 1024 '''1024*768
Command1.Left = 0
Command1.Width = 15480 / 3
Command2.Left = Command1.Left + Command1.Width
Command2.Width = 15480 / 3
Command3.Left = Command2.Left + Command2.Width
Command3.Width = 15480 / 3
End Select
End Sub
只是打个比方
^_^
当然这个例子并不好,只不过提供实例而已.
则可有代码:
Option Explicit
Private Sub Form_Load()
'''800*600时窗体宽度是12120twip
'''1024*768时窗体宽度是15480twip
'''则有以下代码
Dim I As Integer
I = Screen.Width / Screen.TwipsPerPixelX
Select Case I
Case 800 '''800*600
Command1.Left = 0
Command1.Width = 12120 / 3
Command2.Left = Command1.Left + Command1.Width
Command2.Width = 12120 / 3
Command3.Left = Command2.Left + Command2.Width
Command3.Width = 12120 / 3
Case 1024 '''1024*768
Command1.Left = 0
Command1.Width = 15480 / 3
Command2.Left = Command1.Left + Command1.Width
Command2.Width = 15480 / 3
Command3.Left = Command2.Left + Command2.Width
Command3.Width = 15480 / 3
End Select
End Sub
114 2002-04-03
- 打赏
- 举报
我如何条呢！请您说具体点，我在不同分辨率的机器上会是什么结果？？
谢谢大点！
谢谢大点！
combread 2002-04-03
- 打赏
- 举报
注意:
每次调整屏幕的分辨率,都会激发
Form_Paint()
事件.
至少通过操作系统来调节是这样的
每次调整屏幕的分辨率,都会激发
Form_Paint()
事件.
至少通过操作系统来调节是这样的
combread 2002-04-03
- 打赏
- 举报
首先判断屏幕的分辨率.示例代码如下
Private Sub Command1_Click()
MsgBox "屏幕宽为" & Screen.Width / Screen.TwipsPerPixelX & "高为" & Screen.Height / Screen.TwipsPerPixelY & "像素"
End Sub
然后根据不同的分辨率,分别设置各个控件的大小和位置
Private Sub Command1_Click()
MsgBox "屏幕宽为" & Screen.Width / Screen.TwipsPerPixelX & "高为" & Screen.Height / Screen.TwipsPerPixelY & "像素"
End Sub
然后根据不同的分辨率,分别设置各个控件的大小和位置
