[分享]根據(jù)屏幕分辨率自動(dòng)調(diào)整窗體大小以及讓控件自適應(yīng)屏幕分辨率

eyewitnes

根據(jù)屏幕分辨率自動(dòng)調(diào)整窗體大小


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


獲得系統(tǒng)的屏幕區(qū)域大小


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





讓控件自適應(yīng)屏幕分辨率2
來(lái)源：ACCESS愛(ài)好者


'這個(gè)函數(shù)可以使你開(kāi)發(fā)的程序適應(yīng)各種分辨率，這是我見(jiàn)過(guò)的最完美的解決方案！強(qiáng)列推薦


''如果你是在1024*768的分辨率下寫的程序，就把下面那句改為
Const DesignSize = 1024，如果是800*600分
'辨率下寫的，就改為Const DesignSize = 800
'用法：把下面所有的代碼放在一個(gè)模塊里，在需要適應(yīng)分辨率的窗體的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


'國(guó)標(biāo)碼宣言
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()
'現(xiàn)在分辨率取得
ret = GetWindowRect(hWnd, R)
'比例計(jì)算 常例：現(xiàn)在800 開(kāi)發(fā)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


'現(xiàn)在分辨率＝開(kāi)發(fā)分辨率如果終了
If X = DesignSize Then Exit Function
If X < DesignSize Then
'細(xì)小策劃時(shí)、控制＞部分＞表單的次序
Call ChangeCtrl
Call ChengeSec
Call ChangeFrm
Else
'大掬取時(shí)、表單＞部分＞控制的次序
Call ChangeFrm
Call ChengeSec
Call ChangeCt

wmok

不行啊，第二種方法 提示ChangeCtrl未定義。。。。。

fswxs

樓主還是做個(gè)例子更能說(shuō)明問(wèn)題，比如原窗體設(shè)計(jì)不受任何影響的顯示。

tz-chf

控件位置不變，光變窗體大小沒(méi)什么用。

goto2008

樓主做個(gè)例子放上來(lái)吧....

hi-wzj

象很多游戲，它只是用api更改屏幕的分辨率為游戲所設(shè)定的分辨率，退出時(shí)還原回來(lái)就行了，這樣代碼就簡(jiǎn)單很多。

goto2008

原帖由 hi-wzj 于 2007-8-31 10:33 發(fā)表
象很多游戲，它只是用api更改屏幕的分辨率為游戲所設(shè)定的分辨率，退出時(shí)還原回來(lái)就行了，這樣代碼就簡(jiǎn)單很多。

我原先在1024*768分辨率下編的..有些窗體還采用最大化..

結(jié)果到了1280*800的分辨率就亂了套...

后來(lái)..我把窗體的屬性設(shè)為...細(xì)邊框.....不能最大化..才得算保持窗體原型.

大哥..說(shuō)的,,,,感覺(jué)有點(diǎn)疑問(wèn)......

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

會(huì)不會(huì)這樣?........

ccczzz

原帖由 hi-wzj 于 2007-8-31 10:33 發(fā)表
象很多游戲，它只是用api更改屏幕的分辨率為游戲所設(shè)定的分辨率，退出時(shí)還原回來(lái)就行了，這樣代碼就簡(jiǎn)單很多。

這是一個(gè)最簡(jiǎn)單有效的方法，但是有一個(gè)不太友好的過(guò)程，對(duì)軟件知識(shí)不多的人可能會(huì)嚇一跳，屏幕突然改變了。我想能否這樣做，在應(yīng)用軟件打開(kāi)后，在不知不覺(jué)中改變了屏幕分辨率，在退出時(shí)也能在不知不覺(jué)中恢復(fù)原樣。希望各位高手想想辦法，在編程世界，聽(tīng)到過(guò)一句話：“只怕想不到，不怕做不到�！�，靜候佳音，謝謝。

wmok

頂一下，希望能夠引起高手們的注意。。。。
這個(gè)問(wèn)題，個(gè)人覺(jué)得相當(dāng)重要。。。。。

ccczzz

這個(gè)問(wèn)題，個(gè)人覺(jué)得相當(dāng)重要,希望能夠引起高手們的注意。。。。