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上一页 [1] [2] [3] [4] [5] 下一页
|
网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！） 