Dim Msg(9) As String
　　Dim Counter As Long
　　Dim MsgIndex As Long
　　Dim bDrawText As Boolean
　　Dim lastTime As Long
　　Dim XPos As Long, YPos As Long
　　Dim wait As Long
　　Dim Angle As Single
　　Dim Flag As Boolean
　　Dim Count As Long
　　Dim CurModeActiveStatus As Boolean
　　Dim bRestore As Boolean
　　Dim Mode As Boolean
　　Private Sub Main()
　　 InitializeDX
　　'初始化Picture1以获得DirectDraw界面图像
　　 With MainForm.Picture1 .Width = 640 ＊ Screen.TwipsPerPixelX .Height = 480 ＊ Screen.TwipsPerPixelY
　　 End With
　　DDSBack.SetForeColor RGB(255, 255, 255)
　　 MainForm.Font.Name = “宋体”
　　 DDSBack.SetFont MainForm.Font
　　Msg(0) =“一个显示火焰字的演示”
　　Msg(1) =“演示”
　　Msg(2) =“利用VB阵列”
　　Msg(3) =“对显示内存”
　　Msg(4) =“进行直接存取”
　　Msg(5) =“{Esc}键退出”
　　 '设置8位的调色板
　　 For Index = 0 To 84
　　 Pal(Index ＋ 1).red = Index ＊ 3 ＋ 3
　　 Pal(Index ＋ 1).green = 0
　　 Pal(Index ＋ 1).blue = 0
　　 Pal(Index ＋ 86).red = 255
　　 Pal(Index ＋ 86).green = Index ＊ 3 ＋ 3
　　 Pal(Index ＋ 86).blue = 0
　　 Pal(Index ＋ 171).red = 255
　　 Pal(Index ＋ 171).green = 255
　　 Pal(Index ＋ 171).blue = Index ＊ 3 ＋ 3
　　 Next
　　Set Palette = DDraw.CreatePalette(DDPCAPS_8BIT _ Or DDPCAPS_ALLOW256, Pal())
　　 DDSFront.SetPalette Palette
　　AlphaRect.Right = DDSBackDesc.lWidth － 1
　　AlphaRect.Bottom=DDSBackDesc.lHeight－ 1
　　 DDSBack.Lock AlphaRect, DDSBackDesc, DDLOCK_WAIT, 0
　　 
　　 DDSBack.GetLockedArray Pict()
　　 For X = 0 To 639
　　 For Y = 0 To 479
　　 Pict(X, Y) = 0
　　 Next
　　 Next
　　 'Corresponding unlock
　　 DDSBack.Unlock AlphaRect
　　 While Not ExitLoop
　　 Mode = ExModeActive
　　 bRestore = False
　　 Do Until ExModeActive
　　 DoEvents
　　 bRestore = True
　　 Loop
　　 DoEvents
　　 If bRestore Then
　　 bRestore = False
　　 DDraw.RestoreAllSurfaces
　　 End If
　　 DDSBack.Lock AlphaRect, DDSBackDesc, DDLOCK_WAIT, 0
　　 DDSBack.GetLockedArray Pict()
　　 For Y = 0 To 479
　　 Pict(0, Y) = 0
　　 Pict(639, Y) = 0
　　 Next
　　 For X = 0 To 639
　　 Pict(X, 477) = Rnd ＊ 220 ＋ 35
　　 Pict(X, 478) = Rnd ＊ 220 ＋ 35
　　 Pict(X, 479) = Rnd ＊ 220 ＋ 35
　　 Next
　　 Accum = 0
　　 For X = 1 To 638
　　 For Y = 0 To 477
　　 Accum = (Accum ＋ Pict(X, Y ＋ 1) _
　　 ＋ Pict(X, Y ＋ 2) _
　　 ＋ Pict(X ＋ 1, Y ＋ 1) _
　　 ＋ Pict(X － 1, Y ＋ 1)) \ 5
　　 If Accum < 0 Then
　　 Accum = 0
　　 ElseIf Accum > 255 Then
　　 Accum = 255
　　 End If
　　 Pict(X, Y) = Accum
　　 Next
　　 Next
　　 For X = 0 To 639
　　 Pict(X, 0) = 0
　　 Pict(X, 1) = 0
　　 Next
　　 X = Rnd ＊ 639
　　 For Y = 50 To 439
　　 Next
　　 DDSBack.Unlock AlphaRect
　　If DX.TickCount() － lastTime > wait Then
　　 If Counter = 0 Then
　　 bDrawText = True
　　 Counter = 1
　　 XPos = Rnd ＊ 200
　　 YPos = 300 ＋ Rnd ＊ 140
　　 wait = 400
　　 ElseIf Counter = 1 Then
　　 MsgIndex = MsgIndex ＋ 1
　　 If MsgIndex > 5 Then MsgIndex =

(编辑:anna sui)