设置屏幕分辨率?

slf_slf_8 2003-10-16 08:46:08
怎样用vb设置屏幕的分辨率呢?
...全文
270 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
planetike 2003-10-17
  • 打赏
  • 举报
回复
学习
lihonggen0 2003-10-16
  • 打赏
  • 举报
回复
Option Explicit
Const WM_DISPLAYCHANGE = &H7E
Const HWND_BROADCAST = &HFFFF&
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H4
Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const BITSPIXEL = 12
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 Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim OldX As Long, OldY As Long, nDC As Long
Sub ChangeRes(X As Long, Y As Long, Bits As Long)
Dim DevM As DEVMODE, ScInfo As Long, erg As Long, an As VbMsgBoxResult
'Get the info into DevM
erg = EnumDisplaySettings(0&, 0&, DevM)
'This is what we're going to change
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = X 'ScreenWidth
DevM.dmPelsHeight = Y 'ScreenHeight
DevM.dmBitsPerPel = Bits '(can be 8, 16, 24, 32 or even 4)
'Now change the display and check if possible
erg = ChangeDisplaySettings(DevM, CDS_TEST)
'Check if succesfull
Select Case erg&
Case DISP_CHANGE_RESTART
an = MsgBox("You've to reboot", vbYesNo + vbSystemModal, "Info")
If an = vbYes Then
erg& = ExitWindowsEx(EWX_REBOOT, 0&)
End If
Case DISP_CHANGE_SUCCESSFUL
erg = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
ScInfo = Y * 2 ^ 16 + X
'Notify all the windows of the screen resolution change
SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal Bits, ByVal ScInfo
MsgBox "Everything's ok", vbOKOnly + vbSystemModal, "It worked!"
Case Else
MsgBox "Mode not supported", vbOKOnly + vbSystemModal, "Error"
End Select
End Sub
Private Sub Form_Load()
Dim nDC As Long
'retrieve the screen's resolution
OldX = Screen.Width / Screen.TwipsPerPixelX
OldY = Screen.Height / Screen.TwipsPerPixelY
'Create a device context, compatible with the screen
nDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
'Change the screen's resolution
ChangeRes 640, 480, GetDeviceCaps(nDC, BITSPIXEL)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'restore the screen resolution
ChangeRes OldX, OldY, GetDeviceCaps(nDC, BITSPIXEL)
'delete our device context
DeleteDC nDC
End Sub
rainstormmaster 2003-10-16
  • 打赏
  • 举报
回复
下面的例子将演示如何把屏幕分辨率更改为640x480(保持原来的颜色数)。

 

Dim DevM As DEVMODE

'DevM收集信息

erg& = EnumDisplaySettings(0&, 0&, DevM)

'不改变颜色数目是因为如果改变颜色数就要重新启动

 

DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 'Or DM_BITSPERPEL

DevM.dmPelsWidth = 640 '屏幕宽度

DevM.dmPelsHeight = 480 '屏幕高度

'DevM.dmBitsPerPel = 32 (还可以为 8, 16, 32甚至4)

调整分辩率和取当前分辩率

 

改变显示模式并检查是否可能

erg& = ChangeDisplaySettings(DevM, CDS_TEST)'检查是否成功 Select Case erg&

Case DISP_CHANGE_RESTART

an = MsgBox("你现在必须重新启动系统,执行吗?", vbYesNo + vbSystemModal, "消息")

If an = vbYes Then erg& = ExitWindowsEx(EWX_REBOOT, 0&)

End If

Case DISP_CHANGE_SUCCESSFUL

erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)

MsgBox "一切正常!", vbOKOnly + vbSystemModal, "成功"

Case Else

MsgBox "显示模式不支持", vbOKOnly + vbSystemModal, "错误"End Select

End Sub
守城小轩 2003-10-16
  • 打赏
  • 举报
回复
Option Explicit

Public Const CCHFORMNAME = 32
Public Const CCHDEVICENAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000

Public Const CDS_UPDATEREGISTRY = 1
Public Const CDS_TEST = 2

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

Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long


Option Explicit

Dim nDisplay As Integer, devM() As DEVMODE

Private Sub Command1_Click()
devM(List1.ListIndex).dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL

If ChangeDisplaySettings(devM(List1.ListIndex), CDS_TEST) = 0 Then
MsgBox "测试成功!"
Else
MsgBox "测试失败!"
End If
End Sub

Private Sub Command2_Click()
devM(List1.ListIndex).dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL

If ChangeDisplaySettings(devM(List1.ListIndex), 0) = 0 Then
MsgBox "设定成功!"
Else
MsgBox "设定失败!"
End If
End Sub

Private Sub Form_Load()
Dim HasMore As Long, i As Integer

i = 0
Do
ReDim Preserve devM(0 To i)

HasMore = EnumDisplaySettings(0, i, devM(i))
If HasMore = 0 Then Exit Do
If devM(i).dmBitsPerPel = 24 Then
List1.AddItem "全彩" & vbTab & _
devM(i).dmPelsWidth & vbTab & devM(i).dmPelsHeight
Else
List1.AddItem 2 ^ devM(i).dmBitsPerPel & vbTab & _
devM(i).dmPelsWidth & vbTab & devM(i).dmPelsHeight
End If
i = i + 1
Loop
nDisplay = i
End Sub


给你个例子
守城小轩 2003-10-16
  • 打赏
  • 举报
回复
用api
hxy2003 2003-10-16
  • 打赏
  • 举报
回复
up
online 2003-10-16
  • 打赏
  • 举报
回复
已经测试
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

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


Const CCDEVICENAME = 32

Const CCFORMNAME = 32

Const DM_PELSWIDTH = &H80000

Const DM_PELSHEIGHT = &H100000


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

Dim DevM As DEVMODE


Sub ChangeRes(iWidth As Single, iHeight As Single)

Dim a As Boolean

Dim i As Integer

i = 0

Do

a = EnumDisplaySettings(0&, i, DevM)

i = i + 1

Loop Until (a = False)


Dim b&

DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT


DevM.dmPelsWidth = iWidth

DevM.dmPelsHeight = iHeight


ChangeDisplaySettings DevM, 0

End Sub

Private Sub Form_Load()
Call ChangeRes(800, 600)
End Sub

1,485

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧