[分享]根据屏幕分辨率自动调整窗体大小以及让控件自适应屏幕分辨率

eyewitnes

根据屏幕分辨率自动调整窗体大小


Option Compare Database


Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long


Private Const SM_CXSCREEN = 0


Private Const SM_CYSCREEN = 1








Private Sub Form_Open(Cancel As Integer)


Dim x As Long, y As Long, a As Long, b As Long


x = GetSystemMetrics(SM_CXSCREEN)


y = GetSystemMetrics(SM_CYSCREEN)


a = 10000 / 800 * x


b = 7000 / 600 * y


DoCmd.MoveSize 1134, 1134, a, b


End Sub


获得系统的屏幕区域大小


Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1


Private Sub Command0_Click()
Dim x As Long, y As Long
x = GetSystemMetrics(SM_CXSCREEN)
y = GetSystemMetrics(SM_CYSCREEN)
MsgBox x & "  " & y
End Sub





让控件自适应屏幕分辨率2
来源：ACCESS爱好者


'这个函数可以使你开发的程序适应各种分辨率，这是我见过的最完美的解决方案！强列推荐


''如果你是在1024*768的分辨率下写的程序，就把下面那句改为
Const DesignSize = 1024，如果是800*600分
'辨率下写的，就改为Const DesignSize = 800
'用法：把下面所有的代码放在一个模块里，在需要适应分辨率的窗体的Load事
'件里加入Call FormResiz_OnOpen(Me)
'
'Const DesignSize = 1024
Const DesignSize = 800


'☆★☆★☆★☆★☆★☆★☆★☆★☆★


'API宣言
Declare Function GetDesktopWindow Lib "User32" () As Long


Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long


'Type宣言
Type RECT


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


'国标码宣言
Dim frm As Form
Dim ctrl As Control
Dim prp As Property
Dim rat As Double
Dim flgSec
Dim X As Long
Dim WinHeight As Long
Dim hWnd As Long
Dim ret As Long
Dim i As Integer
Dim R As RECT
Dim SizeL As Long
Dim SizeT As Long
Dim SizeW As Long
Dim SizeH As Long


'--------------------------------------------------------------------------------


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 ChangeCt

wmok

不行啊，第二种方法 提示ChangeCtrl未定义。。。。。

fswxs

楼主还是做个例子更能说明问题，比如原窗体设计不受任何影响的显示。

tz-chf

控件位置不变，光变窗体大小没什么用。

goto2008

楼主做个例子放上来吧....

hi-wzj

象很多游戏，它只是用api更改屏幕的分辨率为游戏所设定的分辨率，退出时还原回来就行了，这样代码就简单很多。

goto2008

原帖由 hi-wzj 于 2007-8-31 10:33 发表
象很多游戏，它只是用api更改屏幕的分辨率为游戏所设定的分辨率，退出时还原回来就行了，这样代码就简单很多。

我原先在1024*768分辨率下编的..有些窗体还采用最大化..

结果到了1280*800的分辨率就乱了套...

后来..我把窗体的属性设为...细边框.....不能最大化..才得算保持窗体原型.

大哥..说的,,,,感觉有点疑问......

把1280*800的分辨率改为1024*768......屏幕好像就不好看了...

会不会这样?........

ccczzz

原帖由 hi-wzj 于 2007-8-31 10:33 发表
象很多游戏，它只是用api更改屏幕的分辨率为游戏所设定的分辨率，退出时还原回来就行了，这样代码就简单很多。

这是一个最简单有效的方法，但是有一个不太友好的过程，对软件知识不多的人可能会吓一跳，屏幕突然改变了。我想能否这样做，在应用软件打开后，在不知不觉中改变了屏幕分辨率，在退出时也能在不知不觉中恢复原样。希望各位高手想想办法，在编程世界，听到过一句话：“只怕想不到，不怕做不到。”，静候佳音，谢谢。

wmok

顶一下，希望能够引起高手们的注意。。。。
这个问题，个人觉得相当重要。。。。。

ccczzz

这个问题，个人觉得相当重要,希望能够引起高手们的注意。。。。