|
|
发表于 2007-7-11 21:27:00
|
显示全部楼层
Re:如何取得当前系统的分辨率和颜色位数 ?
screen.Width 方法并不好，在非正常改变Window的分辨率后，其返回值有误
你可以使用 DX7 只做改变分辨率的功能。另一种方法就是使用API，但这个比较危险，一旦程序没有执行还原分辨率的方法（例：非法退出）分辨率就不会还原，如果你把刷新率设的高出显示器的范围，后果可想而知！
下面是一个API改变分辨率的类
建一个类：CDisplaySetting
代码如下
'天魂制作
Option Explicit
Private Const CCHDEVICENAME As Integer = 32
Private Const CCHFORMNAME As Integer = 32
Private Const DM_PELSWIDTH As Long = &H80000
Private Const DM_PELSHEIGHT As Long = &H100000
Private Const DM_DISPLAYFREQUENCY As Long = &H400000 '刷新频率常量
Private Const DM_BITSPERPEL = &H40000 'BPP
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
'获得分辨率和色彩度
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
'更改分辨率和色彩度
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Integer, ByVal iModeNum As Integer, ByRef lpDevMode As DEVMODE) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByVal lpDevMode As Long, ByVal dwFlags As Long) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private ScreenWidth As Integer
Private ScreenHeight As Integer
Private ScreenBPP As Integer
Private ScreenFreq As Integer
Private bReturn As Boolean
Public NewWidth As Integer
Public NewHeight As Integer
Public NewFreq As Integer
Public NewBPP As Integer
'***************************************
'获取屏幕分辨率
'***************************************
Public Sub GetDisplayMode(ByRef Width As Integer, ByRef Height As Integer, ByRef BPP As Integer, ByRef Frequency As Integer)
Dim hdesktopwnd As Long
Dim hdccaps As Long
Dim retVal As Long
hdccaps = GetDC(hdesktopwnd)
'色深
BPP = GetDeviceCaps(hdccaps, 12)
Width = GetDeviceCaps(hdccaps, 8)
Height = GetDeviceCaps(hdccaps, 10)
Frequency = GetDeviceCaps(hdccaps, 116)
retVal = ReleaseDC(hdesktopwnd, hdccaps)
End Sub
'***************************************
'设置屏幕分辨率
'***************************************
Public Function SetDisplayMode(ByRef Width As Integer, ByRef Height As Integer, Optional ByRef BPP As Integer = 16, Optional ByRef Frequency As Integer = 75)
If Width = 0 Or Height = 0 Or BPP = 0 Or Frequency = 0 Then Exit Function
If bReturn = False Then
ScreenWidth = 0
ScreenHeight = 0
ScreenBPP = 0
ScreenFreq = 0
GetDisplayMode ScreenWidth, ScreenHeight, ScreenBPP, ScreenFreq
NewWidth = Width
NewHeight = Height
NewBPP = BPP
NewFreq = Frequency
End If
Dim blnWorked As Boolean
Dim i As Integer
Dim pDevmode As Long
Dim NewDevMode As DEVMODE
Do
blnWorked = EnumDisplaySettings(0, i, NewDevMode)
i = i + 1
Loop Until (blnWorked = False)
With NewDevMode
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL 'Or DM_DISPLAYFREQUENCY
.dmPelsWidth = Width
.dmPelsHeight = Height
.dmBitsPerPel = BPP
'刷新频率
'.dmDisplayFrequency = Frequency
End With
pDevmode = lstrcpy(NewDevMode, NewDevMode)
SetDisplayMode = ChangeDisplaySettings(pDevmode, 0)
SetCursorPos Width, Height
End Function
Public Sub Reset()
SetDisplayMode NewWidth, NewHeight, NewBPP, NewFreq
End Sub
Public Sub ReturnWindow()
bReturn = True
SetDisplayMode ScreenWidth, ScreenHeight, ScreenBPP, ScreenFreq
bReturn = False
End Sub
|
|
