请问在vb程序界面设计中如何能够摆脱屏幕解析度的限制？

[helloparker]

就是说，无论是800x600还是1024x768，所看到的界面都是相对屏幕的比例
多谢

[刘洪峰AIoT]

有一个控件，只要放上它，所有的控件大小都随窗体变化，不过字体也相应变大，象放大镜。
要的话，留下Email

[helloparker]

[e-mail]
请高人传授

[YFY]

麻烦给我一份：[e-mail] 谢谢

[刘洪峰AIoT]

这是一段源码，刚刚编的，也能解决上面问题：

Option Explicit
Private Type RECT
Left As Long
Top As Long
Width As Long
Height As Long
End Type
Private crlMsg() As RECT
Private sngWidth As Single
Private sngHeight As Single
Private sngScaleX As Single
Private sngScaleY As Single
Private intNum As Integer

Private Sub Form_Load()
'打开错误处理陷阱
On Error GoTo ErrGoto
'----------------------------------------------------
'代码正文

Dim i As Integer
intNum = Me.Controls.Count
ReDim Preserve crlMsg(intNum - 1) As RECT

For i = 0 To intNum - 1
crlMsg(i).Left = Me.Controls(i).Left
crlMsg(i).Top = Me.Controls(i).Top
crlMsg(i).Width = Me.Controls(i).Width
crlMsg(i).Height = Me.Controls(i).Height
Next

sngWidth = Me.Width
sngHeight = Me.Height

sngScaleX = 1
sngScaleY = 1
'----------------------------------------------------
Exit Sub
'-----------------------------
ErrGoto:
Resume Next

End Sub

Private Sub Form_Resize()
'打开错误处理陷阱
On Error GoTo ErrGoto
'----------------------------------------------------
'代码正文
Static oldX As Single
Static oldY As Single
Dim i As Integer

sngScaleX = Me.Width * 1# / sngWidth
sngScaleY = Me.Height * 1# / sngHeight

If Abs(sngScaleX - oldX) > 0.01 Or Abs(sngScaleY - oldY) > 0.01 Then
For i = 0 To intNum - 1
Me.Controls(i).Left = crlMsg(i).Left * sngScaleX
Me.Controls(i).Top = crlMsg(i).Top * sngScaleY
Me.Controls(i).Width = crlMsg(i).Width * sngScaleX
Me.Controls(i).Height = crlMsg(i).Height * sngScaleY
Next
End If

oldX = sngScaleX
oldY = sngScaleY

'----------------------------------------------------
Exit Sub
'-----------------------------
ErrGoto:
Resume Next

End Sub


'控件已发

[lihonggen0]

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

[lihonggen0]

Private Sub Form_Load()
ResizeInit Me
End Sub

Private Sub Form_Resize()
ResizeForm Me
End Sub

[richardbao]

你可以用 Screen.Height 和 Screen.Width 取得屏幕的分辨率，然后把遍历 Form.Controls 中的每一个控件，以百分比去设定它们的位置和大小。

[helloparker]

好辛苦

[helloparker]

有没有更好的方法？

[xixixi9988]

好像没有，我一直都没找到好的解决方法