原则上，只改这一次，下一次开机会还原，但如果需重开机，才会Update

Registry中的设定，并重开机。

如果要永久设定其设定值，请将

b = ChangeDisplaySettings(DevM, 0) 改成

b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)

Option Explicit

Private Declare Function EnumDisplaySettings Lib "user32" Alias _

  "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, _

  ByVal iModeNum As Long, lpDevMode As Any) As Long

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

Const EWX_REBOOT = 2     ' 重开机

Const CCDEVICENAME = 32

Const CCFORMNAME = 32

Const DM_PELSWIDTH = &H80000

Const DM_PELSHEIGHT = &H100000

Const DISP_CHANGE_SUCCESSFUL = 0

Const DISP_CHANGE_RESTART = 1

Const CDS_UPDATEREGISTRY = 1

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 DevM As DEVMODE

Private Sub Command1_Click()

  Dim i As Long

  Dim b As Long

  Dim ans as Long

  Dim a As Long

  a = EnumDisplaySettings(0, 0, DevM) 'Initial Setting

  DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

  DevM.dmPelsWidth = 800  '设定成想要的分辨率

  DevM.dmPelsHeight = 600

  b = ChangeDisplaySettings(DevM, 0) 'Changed Only this time

  If b = DISP_CHANGE_RESTART Then

    ans = MsgBox("要重开机设定才能完成，重开？", vbOKCancel)

    If ans = 1 Then

      b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)

      'after this , Will Update in Registry

      Call ExitWindowsEx(EWX_REBOOT, 0)

    End If

  Else

    If b <> DISP_CHANGE_SUCCESSFUL Then

     Call MsgBox("设定有误", vbCritical)

    End If

  End If

End Sub