Office中国论坛/Access中国论坛

标题: 怎么自动调整窗口适应不同的屏幕分辨率 [打印本页]

作者: yang_hf 时间: 2009-3-3 19:49
标题: 怎么自动调整窗口适应不同的屏幕分辨率
我在一电脑上做了一个数据库的窗口,在另外一台上打开,窗口显示和原来都不同了,请问有什么办法自动调整窗口适应不同的屏幕分辨率????

作者: 82077802 时间: 2009-3-3 20:20
Declare Function GetDesktopWindow Lib "USER32" () As Long
Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, rectangle As RECT) As Long

'这个函数可以使你开发的程序适应各种分辨率，这是我见过的最完美的解决方案！强列推荐
'如果你是在1024*768的分辨率下写的程序，就把下面那句改为
'Const DesignSize = 1024，如果是800*600分
'辨率下写的，就改为Const DesignSize = 800
'用法：把下面所有的代码放在一个模块里，在需要适应分辨率的窗体的Load事件里加入：
'Call FormResiz_OnOpen(Me)
'
'Const DesignSize = 1024
Const DesignSize = 800

Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type

Private frm As Form
Private ctrl As Control
Private prp As Property
Private rat As Double
Private flgSec
Private x As Long
Private WinHeight As Long
Private hWnd As Long
Private ret As Long
Private I As Integer
Private R As RECT
Private SizeL As Long
Private SizeT As Long
Private SizeW As Long
Private SizeH As Long

作者: 82077802 时间: 2009-3-3 20:21
Public Function FormResiz_OnOpen(parFrm As Form, Optional perSizeL As Long, Optional perSizeT As Long, Optional perSizeW As Long, Optional perSizeH As Long)
On Error Resume Next
Set frm = parFrm
'窗口驾驶盘的取得
hWnd = GetDesktopWindow()
'现在分辨率取得
ret = GetWindowRect(hWnd, R)
'比例计算常例：现在800 开发1024 800/1024 = 0.78加倍
x = (R.x2 - R.x1)
rat = x / DesignSize
SizeL = 0: SizeT = 0: SizeW = 0: SizeH = 0
If Not IsEmpty(perSizeL) = True Then
SizeL = perSizeL * rat
SizeT = perSizeT * rat
SizeW = perSizeW * rat
SizeH = perSizeH * rat
End If

'现在分辨率＝开发分辨率如果终了
If x = DesignSize Then Exit Function
If x < DesignSize Then
'细小策划时、控制＞部分＞表单的次序
Call ChangeCtrl
Call ChengeSec
Call ChangeFrm
Else
'大掬取时、表单＞部分＞控制的次序
Call ChangeFrm
Call ChengeSec
Call ChangeCtrl
End If
'最后、表单的使清新
frm.Refresh
Exit Function
End Function
'--------------------------------------------------------------------------------
Private Sub ChangeCtrl()
On Error Resume Next
For Each ctrl In frm.Controls
'选项卡修正，原著没有这段代码，后来有个朋友发现了这个BUG，就是选项卡的位置会偏得很厉害
'所以就加了这段代码来修正
'主要是"Top", "Height","Left","Width"这几个参数的值，根据实际情况适当调整就行了
If ctrl.ControlType = 123 or ctrl.ControlType = 124 Then
For Each prp In ctrl.Properties
Select Case prp.name
Case "FontSize", "DatasheetFontHeight"
prp.Value = Fix(prp.Value * rat + 0.5)
Case "FontWeight"
prp.Value = Fix((prp.Value * rat) / 100) * 100
Case "Top", "Height"
prp.Value = Fix(prp.Value * rat * 0.85)
'prp.value = Fix(prp.value * rat)
Case "Left"
prp.Value = Fix(prp.Value * rat * 0.9)
Case "Width"
prp.Value = Fix(prp.Value * rat * 0.7)
End Select
Next
Else
For Each prp In ctrl.Properties
'大小·配置关于属性被发现们压缩
Select Case prp.name
Case "FontSize", "DatasheetFontHeight"
'通常计算假如行…情况之下的 +0.5 之类的话不需要是…但…、
'捆Zo~Ma办法。稍微心情坏因为 +0.5
prp.Value = Fix(prp.Value * rat + 0.5)
Case "FontWeight"
prp.Value = Fix((prp.Value * rat) / 100) * 100
Case "Left", "Top", "Width", "Height"
prp.Value = Fix(prp.Value * rat)
End Select
Next
End If
Next
End Sub
'--------------------------------------------------------------------------------
Private Sub ChengeSec()
On Error GoTo Err_Disp-----------------------------------------

作者: yang_hf 时间: 2009-3-3 21:32
谢谢!

作者: tz-chf 时间: 2009-3-3 22:14
改分辨率是个吃力不讨好的事情,把窗体设成对话框模式就差不多了

作者: cp_dl 时间: 2010-3-26 14:47
很好

作者: chang 时间: 2010-4-13 19:40
试一下先,谢

作者: wufeng980114 时间: 2010-9-3 21:15
路过，学习了

作者: yyinfo 时间: 2010-9-3 21:28
窗体设成对话框模式请问这个在哪里设置啊

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)