VB 高手请帮忙!!分辨率问题

gazaqiang 2008-03-29 09:30:59
我用以下这段代码修改显示器的分辨率,改成1024×768,成功了,但为什么我用Screen.Width/Screen.TwipsPerPixelX再次获取其宽度时,显示却是768,而不是1024,也就是说返回值W*H=768*768,为什么会这样??

恳请高手解释一下!!

If Screen.Width / Screen.TwipsPerPixelX = 1024 And Screen.Height / Screen.TwipsPerPixelY = 768 Then
Exit Sub
Else
RestoreSize = True '需要重建为真

OldWidth = Screen.Width / Screen.TwipsPerPixelX '记录原先分辨率,以便之后还原
OldHeight = Screen.Height / Screen.TwipsPerPixelY
OldBitsPerPel = 32

Dim DevM As DEVMODE '注释:Get the info into
DevMerg& = EnumDisplaySettings(0&, 0&, DevM) '注释:We don't change the colordepth, because a reboot will be necessary
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL

DevM.dmPelsWidth = 1024 'ScreenWidth
DevM.dmPelsHeight = 768 'ScreenHeight
DevM.dmBitsPerPel = 32 '(could be 8, 16, 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)
Case Else
End Select
End If
...全文
33 点赞 收藏 5
写回复
5 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
gazaqiang 2008-03-31
嗯,谢谢了!!
回复
cbm6666 2008-03-30
'添加 Command1 Command2
'Command1 设为 800 600 当然你可以自己设, Command2 灰复

Option Explicit
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long
Const BITSPIXEL = 12
Const CDS_TEST = &H4
Const GDC_FREQ = 116
Const CCHDEVICENAME As Long = 32
Const CCHFORMNAME As Long = 32
Const DM_PELSHEIGHT As Long = &H100000
Const DM_PELSWIDTH As Long = &H80000
Const DM_BITSPERPEL As Long = &H40000
Const DM_DISPLAYFREQUENCY As Long = &H400000
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
Dim OldW&, OldH&, OldColor&, OldFreq&, Tmpstr&(3), S
Dim NewW&, NewH&, NewColor&, NewFreq&

Private Sub Form_Load()
S = GetScnInfo
OldW = S(0): OldH = S(1): OldColor = S(2): OldFreq = S(3)
Command1.Caption = "设置屏幕" '800,600
Command2.Caption = "灰 复"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Command2_Click
End
End Sub

Private Sub Command1_Click()
NewW = 800: NewH = 600: NewColor = 16: NewFreq = 60
Call SetDisplaymode(NewW, NewH, NewColor, NewFreq)
End Sub

Private Sub Command2_Click()
Call RestScreen
End Sub

Public Sub RestScreen()
Call SetDisplaymode(OldW, OldH, OldColor, OldFreq)
End Sub

Function GetScnInfo() As Long()
Tmpstr(0) = Screen.Width \ Screen.TwipsPerPixelX
Tmpstr(1) = Screen.Height \ Screen.TwipsPerPixelY
Tmpstr(2) = Format(GetDeviceCaps(hdc, BITSPIXEL))
Tmpstr(3) = GetDeviceCaps(Me.hdc, GDC_FREQ)
GetScnInfo = Tmpstr()
End Function

Public Function SetDisplaymode(LngWidth&, LngHeight&, IntColor&, LngFrequency&) As Long
Dim newDevmode As DEVMODE, lngP&
EnumDisplaySettings 0&, 0&, newDevmode
With newDevmode
.dmFields = DM_PELSHEIGHT Or DM_PELSWIDTH Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
.dmPelsWidth = LngWidth
.dmPelsHeight = LngHeight
.dmBitsPerPel = IntColor
.dmDisplayFrequency = LngFrequency
End With
SetDisplaymode = ChangeDisplaySettings(newDevmode, CDS_TEST)
End Function

回复
cbm6666 2008-03-29
Const BITSPIXEL = 12
Const CDS_TEST = &H4
Const GDC_FREQ = 116
Const DM_PELSHEIGHT As Long = &H100000
Const DM_PELSWIDTH As Long = &H80000
Const DM_BITSPERPEL As Long = &H40000
Const DM_DISPLAYFREQUENCY As Long = &H400000

你这些常量都没宣告

Type DEVMODE 的设置也没有, 你代码都不全怎么帮你找错 ?

算了, 你这老外的代码别用了, 因为你这代码的写法需要重启后设置才能生效,太麻烦了, 而且玩这东东, 颜色还行,不会乱变,但是频率你不设的话, 将会改变原始的频率到默认的60, 如此便会有人找你麻烦了.

明天帮你整一个吧,今天太晚了.



回复
huangyubinde 2008-03-29
学习
回复
gazaqiang 2008-03-29
高手都去哪了,帮帮忙啦。。。
回复
相关推荐
发帖
VB基础类
创建于2007-09-28

7489

社区成员

VB 基础类
申请成为版主
帖子事件
创建了帖子
2008-03-29 09:30
社区公告
暂无公告