changeresolution.txt

一部分关于VB编程的小技巧

Option Explicit

Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32

Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Const DISP_CHANGE_FAILED = -1
Private Const DISP_CHANGE_BADMODE = -2
Private Const DISP_CHANGE_NOTUPDATED = -3
Private Const DISP_CHANGE_BADFLAGS = -4
Private Const DISP_CHANGE_BADPARAM = -5

Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H2

Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000

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 Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long

Function ChangeScreenSettings(lWidth As Integer, lHeight As Integer, lColors As Integer)
Dim tDevMode As DEVMODE, lTemp As Long, lIndex As Long
' Declare variables
lIndex = 0
Do
  'Instilise Do loop
  lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)
  ' Call the APi function
  If lTemp = 0 Then Exit Do
  ' If there is no more data or an erro occurs
  ' then return 0 and exit do
  lIndex = lIndex + 1
  ' Increase the index to be enumerated

  With tDevMode
    If .dmPelsWidth = lWidth And .dmPelsHeight = lHeight And .dmBitsPerPel = lColors Then
      lTemp = ChangeDisplaySettings(tDevMode, CDS_UPDATEREGISTRY)
      Exit Do
    End If
  End With
  ' Set the new data
  ' Change the display type. This depends on the paramter used
  ' It can either be:
  ' 0 - Dynamic change if possible
  ' CDS_UPDATEREGISTRY - Dynamically change if possible
  ' and if not possibel then  update registry for change
  ' on the next boot-up
  ' CDS_TEST - Test the new settings
Loop

End Function