我想在程序启动时就强制修改窗口显示分辨率,但用下面的代码调试多次未能实现,不知为何?苦恼!请各位高手帮我指正,谢谢!
(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
(2)程序窗口中的代码如下:
Option Explicit
Dim H, V, Color As Long
Dim x, y, z As Integer
  x = Screen.Width \ Screen.TwipsPerPixelX
  y = Screen.Height \ Screen.TwipsPerPixelY
  MsgBox x & "X" & y
  H = GetDeviceCaps(Form1.hdc, HORZRES)
  V = GetDeviceCaps(Form1.hdc, VHORZRES)
  Color = GetDeviceCaps(Form1.hdc, BITSPIXEL)
  z = SetDispMode(1024, 768, 32)  ‘这行语句为何没起作用
  If z = 0 Then
     MsgBox "分辨率没有被改变!"
  End If
程序运行时‘z’始终为0,不知为何?分辨率为何没被修改呢?