bDrawText = False
　　 Counter = 0
　　 wait = 2000
　　 End If
　　 lastTime = DX.TickCount
　　 End If
　　 If bDrawText Then
　　 On Error Resume Next
　　 DDSBack.DrawText XPos, YPos, Msg(MsgIndex), False
　　 On Error GoTo 0
　　 End If
　　 MainForm.Form_Paint
　　 Wend
　　 TerminateDX
　　 End
　　End Sub
　　Function ExModeActive() As Boolean
　　 Dim TestCoopRes As Long
　　TestCoopRes = DDraw.TestCooperativeLevel
　　 Select Case TestCoopRes
　　 Case DDERR_NOEXCLUSIVEMODE
　　 ExModeActive = False
　　 Case DD_OK
　　 ExModeActive = True
　　 End Select
　　End Function
　　Public Sub InitializeDX()
　　MainForm.Left = 0
　　MainForm.Top = 0
　　MainForm.Height =640 ＊ Screen.TwipsPerPixelY
　　MainForm.Width = 480 ＊ Screen.TwipsPerPixelX
　　MainForm.Show
　　 '建立DirectDraw对象
　　 Set DDraw = DX.DirectDrawCreate(“”)
　　 '设定DirectDraw对象的协作层
　　 DDraw.SetCooperativeLevel MainForm.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN ' DDSCL_NORMAL
　　 '设定显示模式位640×480×8位颜色
　　 DDraw.SetDisplayMode 640, 480, 8, 0, DDSDM_DEFAULT
　　 '设定DDSFrontDesc为主平面
　　 With DDSFrontDesc
　　.lFlags = DDSD_CAPS
　　.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE 'Or DDSCAPS_SYSTEMMEMORY
　　 End With
　　 '设定DDSBackDesc为后台缓冲平面
　　 With DDSBackDesc
　　.ddsCaps.lCaps = DDSCAPS_SYSTEMMEMORY
　　.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
　　.lWidth = 640
　　.lHeight = 480
　　 End With
　　 '建立平面
　　 Set DDSFront = DDraw.CreateSurface(DDSFrontDesc)
　　 Set DDSBack = DDraw.CreateSurface(DDSBackDesc)
　　 Set Clipper = DDraw.CreateClipper(0)
　　 Clipper.SetHWnd MainForm.hWnd
　　 DDSFront.SetClipper Clipper
　　 DDSBack.SetClipper Clipper
　　 DoEvents
　　 Exit Sub
　　ERRoUT:
　　 If Not (DDraw Is Nothing) Then
　　 DDraw.RestoreDisplayMode
　　 DDraw.SetCooperativeLevel MainForm.hWnd, DDSCL_NORMAL
　　 DoEvents
　　 End If
　　 MsgBox “无法对DirectDraw进行初始化 ”＋Chr(13)＋“也许你的显示卡不支持 640×480×8 显示模式 ”
　　 End
　　End Sub
　　Public Sub TerminateDX()
　　 '子程序TerminateDX回复原来的显示模式并且释放所有的DirectDraw有关对象
　　 DDraw.RestoreDisplayMode
　　 DDraw.SetCooperativeLevel MainForm.hWnd, DDSCL_NORMAL
　　 DoEvents
　　 Set Clipper = Nothing
　　 Set DDSBack = Nothing
　　 Set DDSFront = Nothing
　　 Set DDraw = Nothing
　　 Set DX = Nothing
　　End Sub
　　在工程文件中再加入一个Module，这个Module主要定义与图像保存相关的操作，在建立的Module中加入以下代码：
　　 Option Explicit
　　Option Base 0
　　Private Type PALETTEENTRY
　　 peRed As Byte
　　 peGreen As Byte
　　 peBlue As Byte
　　 peFlags As Byte
　　End Type
　　
　　Private Type LOGPALETTE
　　 palVersion As Integer
　　 palNumEntries As Integer
　　 palPalEntry(255) As PALETTEENTRY
　　End Type
　　
　　Private Type GUID
　　 Data1 As Long
　　 Data2 As Integer
　　 Data3 As Integer
　　 Data4(7) As Byte
　　End Type
　　Private Const RASTERCAPS As Long = 38
　　Private Const RC_PALETTE As Long = ＆H100
　　Private Const SIZEPALETTE As Long = 10

(编辑:anna sui)