Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long

Private Const CCDEVICENAME As Long = 32
Private Const CCFORMNAME As Long = 32

Private Const DM_BITSPERPEL As Long = &H40000
Private Const DM_PELSWIDTH As Long = &H80000
Private Const DM_PELSHEIGHT As Long = &H100000
Private Const DM_DISPLAYFLAGS As Long = &H200000
Private Const DM_DISPLAYFREQUENCY = &H400000

Private Const CDS_FORCE As Long = &H80000000

Private Const BITSPIXEL As Long = 12
Private Const HORZRES As Long = 8
Private Const VERTRES As Long = 10
Private Const VREFRESH = 116

Private Type DEVMODE
   dmDeviceNameAs String * CCDEVICENAME
   dmSpecVersion  As Integer
   dmDriverVersion   As Integer
   dmSizeAs Integer
   dmDriverExtra  As Integer
   dmFields As Long
   dmOrientation  As Integer
   dmPaperSize As Integer
   dmPaperLength  As Integer
   dmPaperWidthAs 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
   dmBitsPerPelAs Integer
   dmPelsWidth As Long
   dmPelsHeightAs Long
   dmDisplayFlags As Long
   dmDisplayFrequency As Long
End Type

Private Sub cmdChangeDesktopMode_Click()

Dim DM As DEVMODE
  
 With DM
.dmPelsWidth = CInt(txtNewWidth.Text)
.dmPelsHeight = CInt(txtNewHeight.Text)
.dmBitsPerPel = CInt(txtNewColor.Text)
.dmDisplayFrequency = CInt(txtNewFreq.Text)
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
.dmSize = LenB(DM)
 End With
 
 If ChangeDisplaySettings(DM, CDS_FORCE) <> 0 Then
 
  MsgBox "错误!不支持此模式！"
  
 End If

End Sub

Private Sub Form_Load()
   txtOldWidth.Text = GetDeviceCaps(Me.hdc, HORZRES)
   txtOldHeight.Text = GetDeviceCaps(Me.hdc, VERTRES)
   txtOldColor.Text = GetDeviceCaps(Me.hdc, BITSPIXEL)
   txtOldFreq.Text = GetDeviceCaps(Me.hdc, VREFRESH)
End Sub