急~~~~~如何使用api在formload的时候把系统的分辨率改成800*600！

Question

声明：
Private Declare Function 
lstrcpy Lib "kernel32" 
Alias "lstrcpyA" (lpString1 As_
Any, lpString2 As Any) As LongPrivate Declare Function ChangeDisplaySettings
  Lib "user32" Alias_
 "ChangeDisplaySettingsA" (ByVal lpDevMode As Long, 
 ByVal dwflags As Long) As LongPrivate Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32Private Type DEVMODE
        dmDeviceName As String * CCHDEVICENAME
        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 * CCHFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Integer
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End TypePublic Function SetScreen
(Width As Integer,
 Height As Integer, Optional Color 
As Integer = 16) As Long'这里的
16指的是真16色
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
Dim NewDevMode As DEVMODE
Dim pDevmode As LongWith NewDevMode
.dmSize = Len(NewDevMode)'一般为122
If Color = -1 Then
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
        Else
                .dmFields = DM_PELSWIDTH Or 
  DM_PELSHEIGHT Or DM_BITSPERPEL
        End If
        .dmPelsWidth = Width
        .dmPelsHeight = Height
        If Color < > -1 Then
                .dmBitsPerPel = Color
        End If
End WithpDevmode = lstrcpy(NewDevMode, NewDevMode)
SetDisplayMode = ChangeDisplaySettings(pDevmode, 0)
End Function
 Private Sub Change_Click()
SetScreen Val(Text1), Val(Text2), Val(Text3)
End Sub’下面三个文本框分别存放分辨率和颜色值
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End SubPrivate Sub Text2_GotFocus()
Text2.SelStart = 0
Text2.SelLength = Len(Text1)
End SubPrivate Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text1)
End Sub
上面的的代码做不到的，
请高手解答，急~~~~~~~~~~~~~~~~~~~~~

Answer 1

Option Explicit
Public oldwidth As Integer, oldheight As Integer, oldcolor As Integer, oldfreq As Long
Private Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const ENUM_CURRENT_SETTINGS = 1
Private Const BITSPIXEL = 12Const DM_PELSHEIGHT As Long = &H100000
Const DM_PELSWIDTH As Long = &H80000
Const DM_BITSPERPEL As Long = &H40000
Const DM_DISPLAYFREQUENCY As Long = &H400000Const CCHDEVICENAME As Long = 32
Const CCHFORMNAME As Long = 32
Const CDS_TEST = &H4
Const GDC_FREQ = 116Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
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 * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End TypePrivate Sub Change_Click()
    oldwidth = GetDisplayWidth
    oldheight = GetDisplayHeight
    getcolor
    getfreq
    Call initscreen(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text), Val(Text4.Text))
End Sub
Private Sub Form_Load()
    Text1.Text = 800: Text2.Text = 600
    Text3.Text = 16
    Text4.Text = 60
End SubPrivate Sub Form_Unload(Cancel As Integer)
   restscreen   ' 恢复设置
End Sub
Public Sub initscreen(ByVal nwidth As Long, ByVal nheight As Long, ByVal ncolor As Integer, ByVal nfreq As Long)
    Call SetDisplaymode(nwidth, nheight, ncolor, nfreq)
End Sub
Public Sub restscreen()
   Dim nwidth As Long, nheight As Long, ncolor As Integer, nfreq As Long
   nwidth = oldwidth: nheight = oldheight: ncolor = oldcolor: nfreq = oldfreq
   Call SetDisplaymode(nwidth, nheight, ncolor, nfreq)
End Sub
Public Function SetDisplaymode(LngWidth As Long, LngHeight As Long, IntColor As Integer, LngFrequency As Long) As Long
   Dim newDevmode As DEVMODE
   Dim lngP As Long
   EnumDisplaySettings 0&, 0&, newDevmode
   With newDevmode
      .dmFields = DM_PELSHEIGHT Or DM_PELSWIDTH Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
      .dmPelsWidth = LngWidth
      .dmPelsHeight = LngHeight
      .dmBitsPerPel = IntColor
      .dmDisplayFrequency = LngFrequency
   End With
   SetDisplaymode = ChangeDisplaySettings(newDevmode, CDS_TEST)
End Function
Public Function GetDisplayWidth() As Integer
   On Error Resume Next
   GetDisplayWidth = Screen.Width \ Screen.TwipsPerPixelX
End Function
Public Function GetDisplayHeight() As Integer
   On Error Resume Next
   GetDisplayHeight = Screen.Height \ Screen.TwipsPerPixelY
End Function
Public Function getfreq() As Integer
   On Error Resume Next
   oldfreq = GetDeviceCaps(Me.hdc, GDC_FREQ)
End Function
Public Sub getcolor()
   On Error Resume Next
   oldcolor = Format$(GetDeviceCaps(hdc, BITSPIXEL))
End Sub