تغییر تنضیمات صفحه نمایش

Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H2
Const CDS_FULLSCREEN = &H4
Const CDS_GLOBAL = &H8
Const CDS_SET_PRIMARY = &H10
Const CDS_RESET = &H40000000
Const CDS_SETRECT = &H20000000
Const CDS_NORESET = &H10000000
Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const DISP_CHANGE_FAILED = -1
Const DISP_CHANGE_BADMODE = -2
Const DISP_CHANGE_NOTUPDATED = -3
Const DISP_CHANGE_BADFLAGS = -4
Const DISP_CHANGE_BADPARAM = -5

Private Const ENUM_CURRENT_SETTINGS = -1

Private Type DEVMODE
    dmDeviceName As String * 32
    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 * 32
    dmUnusedPadding As Integer
    dmBitsPerPixel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    'Windows 95, 98, 2000
    dmICMMethod As Long
    dmICMIntent As Long
    dmMediaType As Long
    dmDitherType As Long
    dmReserved1 As Long
    dmReserved2 As Long
    'Windows 2000
    dmPanningWidth As Long
    dmPanningHeight As Long
End Type
Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, _
    ByVal iModeNum As Long, lpDevMode As DEVMODE) As Long
Private Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags _
    As Long) As Long

Private Sub Command1_Click()
  Dim dm As DEVMODE
  Dim retval As Long
  dm.dmSize = Len(dm)
  retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)
  dm.dmPelsWidth = 800
  dm.dmPelsHeight = 600
  retval = ChangeDisplaySettings(dm, CDS_TEST)
    If retval <> DISP_CHANGE_SUCCESSFUL Then
        Me.Print "Cannot change to that resolution!"
    Else
       retval = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
        Select Case retval
        Case DISP_CHANGE_SUCCESSFUL
            Me.Print "Resolution successfully changed!"
        Case DISP_CHANGE_RESTART
            Me.Print "A reboot is necessary before the changes will take effect."
        Case Else
            Me.Print "Unable to change resolution!"
        End Select
    End If
End Sub