|
|
|
Vb中实现火焰效果 -zh1110
首先我们要建立一个调色盘 Public Pal(255) As PALETTEENTRY Public Palette As DirectDrawPalette
然后建立一个与屏幕图象一样大小的数组Pict, 类型为字节，用来保存火焰每一个点时刻颜色数据，初始状态时各点都为0，（黑色） Dim Pict() As Byte
因为要显示出火焰拖着一条尾巴的效果，需要对图象进行一些特殊的处理才行。Blur算法即是完成这个目的。（Blur，模糊的意思，）算法是取该象素下方，左方，右方 及上方两个象素的总值，然后除衰减值5，这样看上去象是火焰在向上蒸腾。 主要循环如下： While Not ExitLoop ... '锁住页面 DDSBack.Lock AlphaRect, DDSBackDesc, DDLOCK_WAIT, 0 '获得数组数据Pict DDSBack.GetLockedArray Pict() 两边数值一直为0，目的使火焰向上蒸腾时两边产生向中间靠拢的效果，可免 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为当前象素数据（该象素下方，左方，右方 及上方两个象素的总值，然后除衰减值，衰减值取5左右才有较好火焰效果） 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 '上下限（0-255） If Accum < 0 Then Accum = 0 ElseIf Accum > 255 Then Accum = 255 End If Pict(X, Y) = Accum Next 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 = 0 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
|
