主题:关于窗体自适应分辨率的问题
ictest
[专家分:0] 发布于 2010-06-13 12:49:00
我在家里编写了一个程序,家里显示器的分辨率是1440*900(宽屏),在窗体中我把各个控件放在了合适的位置,但拿到单位使用发现单位的各个电脑的分辨率不尽相同,有800*600、1024*768等等等等,这样就造成窗体和内部的控件显示不全的现象,不知是否有方法可以根据分辨率的不同而自动放大或缩小窗体和内部的控件?我看到网上说可以先求出分辨率后再根据分辨率设置窗体和内部的控件的长和宽,分不同的情况用上几个if。。。then。。。。语句,但是我的这个软件中用上了200多个控件,一一修改是不是太麻烦了?麻烦告知是否有较简便的方法?谢谢啦!
最好附上实例,谢谢了!
回复列表 (共2个回复)
沙发
一江秋水 [专家分:9680] 发布于 2010-06-13 14:50:00
可以加3个控件:一个框架、一个横滚动条、一个竖滚动条。
首先用鼠标把窗体上所有的控件全部选中,剪切,然后添加框架,框架比窗体略小,框架右边加竖滚动条,下面加横滚动条,再把剪切的控件复制到框架内,这样,当拉动滚动条时,只要编写代码使框架移动即可,框架内的控件会自动随框架移动。对滚动条的要求:当窗体能显示整个框架时,滚动条隐藏,当窗体<框架时,滚动条显示出来。参考代码:
Option Explicit
Dim h0 As Integer '窗体 Height 初值
Dim w0 As Integer '窗体 Width 初值
Dim T1 As Integer '框架 Top 初值
Dim L1 As Integer '框架 Left 初值
Private Sub Form_Load()
h0 = Me.ScaleHeight: w0 = Me.ScaleWidth
VScrollBar1.Min = h0: HScrollBar1.Min = w0
T1 = Frame1.Top: L1 = Frame1.Left 'Frame1左上角坐标
End Sub
Private Sub Form_Resize()
VScrollBar1.Visible = IIf(Me.ScaleHeight < h0, True, False)
HScrollBar1.Visible = IIf(Me.ScaleWidth < w0, True, False)
If ScaleHeight > HScrollBar1.Height Then
VScrollBar1.Left = HScrollBar1.Width
VScrollBar1.Height = ScaleHeight + (HScrollBar1.Visible = True) * HScrollBar1.Height
HScrollBar1.Top = VScrollBar1.Height
HScrollBar1.Width = ScaleWidth + (VScrollBar1.Visible = True) * VScrollBar1.Width
VScrollBar1.Max = ScaleHeight - HScrollBar1.Height
HScrollBar1.Max = ScaleWidth - VScrollBar1.Width
VScrollBar1.LargeChange = ScaleHeight
HScrollBar1.LargeChange = ScaleWidth
End If
End Sub
Sub VScrollBar1SonProgram()
Frame1.Top = T1 + VScrollBar1.Value - h0
End Sub
Sub HScrollBar1SonProgram()
Frame1.Left = L1 + HScrollBar1.Value - w0
End Sub
Private Sub VScrollBar1_Change()
VScrollBar1SonProgram
End Sub
Private Sub VScrollBar1_Scroll()
VScrollBar1SonProgram
End Sub
Private Sub HScrollBar1_Change()
HScrollBar1SonProgram
End Sub
Private Sub HScrollBar1_Scroll()
HScrollBar1SonProgram
End Sub
你自己去调整一下吧,反正思路是这样的。
板凳
ictest [专家分:0] 发布于 2010-06-13 15:37:00
我在网上找到一段例子,带到程序里后发现窗体里的控件字体都变小了,这是怎么回事?在那里修改呀?
Option Explicit
Private ObjOldWidth As Long '保存窗体的原始宽度
Private ObjOldHeight As Long '保存窗体的原始高度
Private ObjOldFont As Single '保存窗体的原始字体比
'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
Dim Obj As Control
ObjOldWidth = FormName.ScaleWidth
ObjOldHeight = FormName.ScaleHeight
ObjOldFont = FormName.Font.Size / ObjOldHeight
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 / ObjOldWidth
'保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / ObjOldHeight
'保存窗体高度缩放比例
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
Obj.Font.Size = ObjOldFont * FormName.ScaleHeight
Next i
Next Obj
On Error GoTo 0
End Sub
Private Sub Form_Resize()
'确保窗体改变时控件随之改变
Call ResizeForm(Me)
End Sub
Private Sub Form_Load()
'在程序装入时必须加入
Call ResizeInit(Me)
End Sub
我来回复