我用的函数 Public Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean Public Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long Public oldWidth, oldHigh, oldPerpel As Long Private Const CCDEVICENAME = 32 Private Const CCFORMNAME = 32 Private Const DM_BITSPERPEL = &H40000 Private Const DM_PELSWIDTH = &H80000 Private Const DM_PELSHEIGHT = &H100000 Private Const CDS_UPDATEREGISTRY = &H1 Private Const CDS_TEST = &H4 Private Const DISP_CHANGE_SUCCESSFUL = 0 Private Const DISP_CHANGE_RESTART = 1Private Const ENUM_REGISTRY_SETTINGS = (-2) Private Const ENUM_CURRENT_SETTINGS = (-1)‘刷新频率常量 Private Const DM_DISPLAYFREQUENCY = &H400000Private 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 TypePrivate DevM As DEVMODE Private DevCurrent As DEVMODE Private ret As Long Public Sub ScreenBat(ByVal newWi As Long, ByVal newHi As Long, ByVal newPer As Long, ByVal Scren As String) If Scren = "1024" Then ret = EnumDisplaySettings(0&, ENUM_REGISTRY_SETTINGS, DevM) 'ret = EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DevCurrent) oldWidth = DevM.dmPelsWidth oldHigh = DevM.dmPelsHeight oldPerpel = DevM.dmBitsPerPel 'DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 'Or DM_BITSPERPEL If DevM.dmPelsWidth <> newWi Then DevM.dmPelsWidth = newWi: Scren = "T" '想要设定的屏幕宽度 If DevM.dmPelsHeight <> newHi Then DevM.dmPelsHeight = newHi: Scren = "T" '想要设定的屏幕高度 If DevM.dmBitsPerPel <> newPer Then DevM.dmBitsPerPel = newPer: Scren = "T" ' (could be 8, 16, 32 or even 4) '此行可用于改变色板 If Scren = "T" Then Call ChangeDisplaySettings(DevM, CDS_TEST) ElseIf Scren = "old" Then If DevM.dmPelsWidth <> oldWidth Then DevM.dmPelsWidth = oldWidth: Scren = "T" '恢复屏幕宽度 If DevM.dmPelsHeight <> oldHigh Then DevM.dmPelsHeight = oldHigh: Scren = "T" '恢复屏幕高度 If DevM.dmBitsPerPel <> oldPerpel Then DevM.dmBitsPerPel = oldPerpel: Scren = "T" ' (could be 8, 16, 32 or even 4) '恢复色板 If Scren = "T" Then Call ChangeDisplaySettings(DevM, CDS_TEST)End If End Sub
我的调整分辨率模块为'调整屏幕分辨率 Public Function ChangeRes(width As Single, height As Single, BPP As Integer) As Integer On Error GoTo ERROR_HANDLER Dim DevM As DEVMODE, i As Integer, ReturnVal As Boolean, _ retvalue ', OldWidth As Single, OldHeight As Single, _ 'OldBPP As Integer Call EnumDisplaySettings(0&, -1, DevM) OldWidth = DevM.dmPelsWidth OldHeight = DevM.dmPelsHeight OldBPP = DevM.dmBitsPerPel i = 0 Do ReturnVal = EnumDisplaySettings(0&, i, DevM) i = i + 1 Loop Until (ReturnVal = False) DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL DevM.dmPelsWidth = width DevM.dmPelsHeight = height DevM.dmBitsPerPel = BPP Call ChangeDisplaySettings(DevM, 1) If retvalue = vbCancel Then DevM.dmPelsWidth = OldWidth DevM.dmPelsHeight = OldHeight DevM.dmBitsPerPel = OldBPP Call ChangeDisplaySettings(DevM, 1) ChangeRes = 0 Else ChangeRes = 1 End If Exit Function ERROR_HANDLER: ChangeRes = 0 End Function利用 ChangeDisplaySettings 调整分辨率后, 用 screen.Width = 11520 (如果分辨率正常为1024 时,screen.Width = 15360 ) 如果程序编译后,调整分辨率后,显示不正常,重启程序,后,显示正常是不是我的调整分辨率的函数有问题?
Public Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Public Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Public oldWidth, oldHigh, oldPerpel As Long
Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H4
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1Private Const ENUM_REGISTRY_SETTINGS = (-2)
Private Const ENUM_CURRENT_SETTINGS = (-1)‘刷新频率常量
Private Const DM_DISPLAYFREQUENCY = &H400000Private 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 TypePrivate DevM As DEVMODE
Private DevCurrent As DEVMODE
Private ret As Long
Public Sub ScreenBat(ByVal newWi As Long, ByVal newHi As Long, ByVal newPer As Long, ByVal Scren As String)
If Scren = "1024" Then
ret = EnumDisplaySettings(0&, ENUM_REGISTRY_SETTINGS, DevM)
'ret = EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DevCurrent)
oldWidth = DevM.dmPelsWidth
oldHigh = DevM.dmPelsHeight
oldPerpel = DevM.dmBitsPerPel
'DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 'Or DM_BITSPERPEL
If DevM.dmPelsWidth <> newWi Then DevM.dmPelsWidth = newWi: Scren = "T" '想要设定的屏幕宽度
If DevM.dmPelsHeight <> newHi Then DevM.dmPelsHeight = newHi: Scren = "T" '想要设定的屏幕高度
If DevM.dmBitsPerPel <> newPer Then DevM.dmBitsPerPel = newPer: Scren = "T" ' (could be 8, 16, 32 or even 4) '此行可用于改变色板
If Scren = "T" Then Call ChangeDisplaySettings(DevM, CDS_TEST)
ElseIf Scren = "old" Then If DevM.dmPelsWidth <> oldWidth Then DevM.dmPelsWidth = oldWidth: Scren = "T" '恢复屏幕宽度
If DevM.dmPelsHeight <> oldHigh Then DevM.dmPelsHeight = oldHigh: Scren = "T" '恢复屏幕高度
If DevM.dmBitsPerPel <> oldPerpel Then DevM.dmBitsPerPel = oldPerpel: Scren = "T" ' (could be 8, 16, 32 or even 4) '恢复色板
If Scren = "T" Then Call ChangeDisplaySettings(DevM, CDS_TEST)End If
End Sub
Public Function ChangeRes(width As Single, height As Single, BPP As Integer) As Integer
On Error GoTo ERROR_HANDLER
Dim DevM As DEVMODE, i As Integer, ReturnVal As Boolean, _
retvalue ', OldWidth As Single, OldHeight As Single, _
'OldBPP As Integer
Call EnumDisplaySettings(0&, -1, DevM)
OldWidth = DevM.dmPelsWidth
OldHeight = DevM.dmPelsHeight
OldBPP = DevM.dmBitsPerPel
i = 0
Do
ReturnVal = EnumDisplaySettings(0&, i, DevM)
i = i + 1
Loop Until (ReturnVal = False)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = width
DevM.dmPelsHeight = height
DevM.dmBitsPerPel = BPP
Call ChangeDisplaySettings(DevM, 1)
If retvalue = vbCancel Then
DevM.dmPelsWidth = OldWidth
DevM.dmPelsHeight = OldHeight
DevM.dmBitsPerPel = OldBPP
Call ChangeDisplaySettings(DevM, 1)
ChangeRes = 0
Else
ChangeRes = 1
End If
Exit Function
ERROR_HANDLER:
ChangeRes = 0
End Function利用 ChangeDisplaySettings 调整分辨率后,
用 screen.Width = 11520 (如果分辨率正常为1024 时,screen.Width = 15360 )
如果程序编译后,调整分辨率后,显示不正常,重启程序,后,显示正常是不是我的调整分辨率的函数有问题?
我有个背景窗口,该窗口加载一个图片
Me.PaintPicture Me.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight
每次代码强制改变屏幕分辨率后,该图片就不能满屏显示,只有重新运行该程序才能正常满屏显示
我调试追踪后发现 屏幕分辨率改变后,屏幕的宽度属性没有更新,所以该图片没有满屏( screen.Width = 11520 (如果分辨率正常为1024 时,screen.Width = 15360 ))
看来应该是你窗口设置的问题了,背景图片如果是固定的就直接绑定在窗口中(picture属性)
但是设置其他的就不显示系统工具栏了,怎么设置才能解决这个问题?
MinButton 设为True