Private Declare Function ChangeDisplaySettings Lib "user32" _ 
    Alias "ChangeDisplaySettingsA" _ 
    (lpDevMode As Any, ByVal dwflags As Long) As Long 
Private Declare Function EnumDisplaySettings Lib "user32" _ 
    Alias "EnumDisplaySettingsA" _ 
    (ByVal lpszDeviceName As Long, _ 
    ByVal iModeNum As Long, lpDevMode As Any) As Boolean 
Const DM_PELSWIDTH = &H80000 
Const DM_PELSHEIGHT = &H100000 
Const CCFORMNAME =  32  
Const CCDEVICENAME =  32  
  
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 Sub ChangeResolution(iWidth As Single, iHeight As Single) 
Dim DevM As DEVMODE 
Dim a As Boolean 
Dim i As Long 
Dim b As Long 
i =  0  
Do 
    a = EnumDisplaySettings( 0 &, i&, DevM) 
    i = i +  1  
Loop Until (a = False) 
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 
DevM.dmPelsWidth = iWidth 
DevM.dmPelsHeight = iHeight 
b = ChangeDisplaySettings(DevM,  0 ) 
End Sub 

Private Sub Command1_Click()
ChangeResolution  640 ,  480 
End sub 

Private Sub Command2_Click()
ChangeResolution  800 ,  600 
End sub 

Private Sub Command3_Click()
ChangeResolution  1024 ,  768 
End sub 

Private Sub Command4_Click()
ChangeResolution  1280 ,  1024 
End sub