Question

vb分辨率修改

我想用vb些个修改分辨率的程序，但是自己学习的vb只是还很欠缺，不知道该怎么入手，修改分辨率需要设置哪些参数、空间我都不知道，麻烦高手们给我一个详细的简单的方法，谢谢！

Answer 1

'---------------以下代码用于得到屏幕的设置参数--------------
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
'取指定设备信息API函数
Public Const HORZRES = 8
'三个屏幕常量
Public Const VHORZRES = 10
Public Const BITSPIXEL = 12
'---------------通过字符COPY进行数据类型转换--------------
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long

'------------------以下结构用于屏幕的初始化-----------------
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32

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
'------------------设置屏幕的核心API-----------------
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByVal lpDevMode As Long, ByVal dwflags As Long) As Long
'------------------设置屏幕的函数-----------------
Public Function SetDispMode(Width As Integer, Height As Integer, Color As Integer) As Long
'（SetDispMode是自己构造的更改屏幕设置的函数来，它的三个参数Width?Height和Color分别是屏幕的横向分辨率?纵向分辨率,颜色位数，其值可为24，16，0等。0为原有颜色设置。）
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
Dim NewDevMode As DEVMODE
Dim pDevmode As Long
With NewDevMode
.dmSize = 122
If Color = 0 Then
'如果Color=0则只改变屏幕的分辨率，而不改变色彩。
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
Else
'如果Color不等0则改变屏幕的分辨率和色彩。
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
End If
.dmPelsWidth = Width
.dmPelsHeight = Height
If Color <> 0 Then
.dmBitsPERPel = Color
End If
End With
pDevmode = lstrcpy(NewDevMode, NewDevMode)
'得到一个指向NewDevMode结构的Long型的指针。
ChangeDisplaySettings pDevmode, 0
End Function

Answer 2

下面这几个API的作用你自己查、MSDN

'模块代码
Option Explicit

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

Public Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long

Public Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long

Const DM_PELSHEIGHT As Long = &H100000
Const DM_PELSWIDTH As Long = &H80000
Const DM_BITSPERPEL As Long = &H40000
Const DM_DISPLAYFREQUENCY As Long = &H400000
Public Const HORZRES = 8
Public Const VHORZRES = 10
Public Const VREFRESH = 116

Public Const BITSPIXEL = 12
Const CCHDEVICENAME As Long = 32
Const CCHFORMNAME As Long = 32
Const CDS_TEST = &H4

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

Public Function SetDisplaymode(LngWidth As Long, LngHeight As Long, LngFrequency As Long) As Long
Dim NewDevmode As DEVMODE
Dim lngP As Long
EnumDisplaySettings 0&, 0&, NewDevmode

With NewDevmode
.dmFields = DM_PELSHEIGHT Or DM_PELSWIDTH Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
.dmPelsWidth = LngWidth
.dmPelsHeight = LngHeight
If LngFrequency <> 0 Then
.dmDisplayFrequency = LngFrequency
End If
End With

SetDisplaymode = ChangeDisplaySettings(NewDevmode, 1)
End Function

'窗体代码
Private Sub Form_Load()
SetDisplaymode 1280, 1024, 0
End Sub

Answer 3

我有个2000下好用的 不知道XP好用不 你试一下吧！~

'模块代码
Option Explicit

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

Public Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" _
(ByRef lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long

Public Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal _
lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long

Const DM_PELSHEIGHT As Long = &H100000
Const DM_PELSWIDTH As Long = &H80000
Const DM_BITSPERPEL As Long = &H40000
Const DM_DISPLAYFREQUENCY As Long = &H400000
Public Const HORZRES = 8
Public Const VHORZRES = 10
Public Const VREFRESH = 116

Public Const BITSPIXEL = 12
Const CCHDEVICENAME As Long = 32
Const CCHFORMNAME As Long = 32
Const CDS_TEST = &H4

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

Public Function SetDisplaymode(LngWidth As Long, LngHeight As Long, LngFrequency As Long) As Long
Dim NewDevmode As DEVMODE
Dim lngP As Long
EnumDisplaySettings 0&, 0&, NewDevmode

With NewDevmode
.dmFields = DM_PELSHEIGHT Or DM_PELSWIDTH Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
.dmPelsWidth = LngWidth
.dmPelsHeight = LngHeight
If LngFrequency <> 0 Then
.dmDisplayFrequency = LngFrequency
End If
End With

SetDisplaymode = ChangeDisplaySettings(NewDevmode, 1)
End Function

'窗体代码
Private Sub Form_Load()
SetDisplaymode 1280, 1024, 0
End Sub