设置屏幕分辨率、颜色位数、刷新率

王朝other·作者佚名 2006-01-09

宽屏版字体: 小|中|大|超大

'////////////////////////////////

'//

'//griefforyou收集整理

'//

'////////////////////////////////

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long

Private Const CCDEVICENAME As Long = 32

Private Const CCFORMNAME As Long = 32

Private Const DM_BITSPERPEL As Long = &H40000

Private Const DM_PELSWIDTH As Long = &H80000

Private Const DM_PELSHEIGHT As Long = &H100000

Private Const DM_DISPLAYFLAGS As Long = &H200000

Private Const DM_DISPLAYFREQUENCY = &H400000

Private Const CDS_FORCE As Long = &H80000000

Private Const BITSPIXEL As Long = 12

Private Const HORZRES As Long = 8

Private Const VERTRES As Long = 10

Private Const VREFRESH = 116

Private Type DEVMODE

dmDeviceName As String * CCDEVICENAME

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 * CCFORMNAME

dmUnusedPadding As Integer

dmBitsPerPel As Integer

dmPelsWidth As Long

dmPelsHeight As Long

dmDisplayFlags As Long

dmDisplayFrequency As Long

End Type

Private Sub cmdChangeDesktopMode_Click()

Dim DM As DEVMODE

With DM

.dmPelsWidth = CInt(txtNewWidth.Text)

.dmPelsHeight = CInt(txtNewHeight.Text)

.dmBitsPerPel = CInt(txtNewColor.Text)

.dmDisplayFrequency = CInt(txtNewFreq.Text)

.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY

.dmSize = LenB(DM)

End With

If ChangeDisplaySettings(DM, CDS_FORCE) <> 0 Then

MsgBox "错误!不支持此模式！"

End If

End Sub

Private Sub Form_Load()

txtOldWidth.Text = GetDeviceCaps(Me.hdc, HORZRES)

txtOldHeight.Text = GetDeviceCaps(Me.hdc, VERTRES)

txtOldColor.Text = GetDeviceCaps(Me.hdc, BITSPIXEL)

txtOldFreq.Text = GetDeviceCaps(Me.hdc, VREFRESH)

End Sub