VB实现点爆炸效果

'需在窗体放置以下 4 个控件，所有控件不用设置任何属性，均采用默认设置：
’ Picture1，Command1，Check1，Timer1

Option Explicit
Dim I

Dim ctD() As tyD, ctDs As Long, ctR As Single
Private Type tyD
x As Single
y As Single
toX As Single
toY As Single
Se As Long
Ci As Long
End Type

Private Sub Form_Load()
Me.Caption = “宇宙大爆炸 - 演示”
Command1.Caption = “开始演示”
Check1.Caption = “闪烁光点”
Timer1.Enabled = False
End Sub

Private Sub Command1_Click()
Dim nStr As String

Timer1.Interval = 20
Timer1.Enabled = Not Timer1.Enabled
If Timer1.Enabled ThenCall Init '初始化喷发物
ElsenStr = "已停止"Picture1.Font.Size = 72Picture1.ForeColor = &HFFFFFFPicture1.CurrentX = -Picture1.TextWidth(nStr) * 0.5Picture1.CurrentY = -Picture1.TextHeight(nStr) * 0.5Picture1.Print nStr
End If

End Sub

Private Sub Init()
Dim V As Single, J As Single

Picture1.FillStyle = 0
Picture1.BackColor = &H330000
Picture1.AutoRedraw = TruectR = Picture1.ScaleWidth * 0.5 '红球收缩前的初始半径
ctDs = 1000
ReDim ctD(ctDs)    '初始化喷发物，ctDs 表示总个数Randomize
For I = 1 To ctDsJ = 3.1415926 * 2 * RndV = 0.01 + 5 * Rnd '喷发方向和速度ctD(I).toX = V * Sin(J)ctD(I).toY = V * Cos(J)ctD(I).Se = Rnd * &HFFFFFF '喷发物颜色ctD(I).Ci = Rnd * 3        '初始光点闪烁状态
Next

End Sub

Private Sub Form_Resize()
Dim L As Single, T As Single, H As Single, H1 As Single

'设置控件位置
H1 = Me.TextHeight("A")
L = H1 * 0.3
T = L
Command1.Move L, T, H1 * 6, H1 * 2
Check1.Move L * 3 + Command1.Width, T, H1 * 6, H1 * 2T = T * 2 + Command1.Height
H = Me.ScaleHeight - T
If H > 0 Then Picture1.Move 0, T, Me.ScaleWidth, H'将 Picture1 的中心设置为坐标原点
Picture1.ScaleMode = 3
Picture1.ScaleLeft = -Picture1.ScaleWidth * 0.5
Picture1.ScaleTop = -Picture1.ScaleHeight * 0.5

End Sub

Private Sub Timer1_Timer()
Call Blast
End Sub
Private Sub Blast()
'显示一次爆炸的瞬时状态
Dim I As Long, S As Long, Se As Long
Dim W As Single, W1 As Single, H1 As Single

Picture1.ClsctR = ctR * 0.9            '减小红球半径
If ctR > 10 Then GoTo Red1 '爆炸前，只显示收缩的红球
W1 = Picture1.ScaleWidth * 0.5
H1 = Picture1.ScaleHeight * 0.5For I = 1 To ctDs'得到喷发物 ctD(I) 的新位置，并加速 2%ctD(I).x = ctD(I).x + ctD(I).toXctD(I).y = ctD(I).y + ctD(I).toYctD(I).toX = ctD(I).toX * 1.02ctD(I).toY = ctD(I).toY * 1.02'判断喷发物是否飞出可见区If ctD(I).x < -W1 Or ctD(I).x > W1 Then GoTo NextIIf ctD(I).y < -H1 Or ctD(I).y > H1 Then GoTo NextIS = S + 1 '计数可见喷发物的个数W = 0.02 * Sqr((ctD(I).x) ^ 2 + (ctD(I).y) ^ 2) '根据与中心点的距离确定喷发物的大小If Check1.Value = 1 ThenIf ctD(I).Ci = 0 Then Se = 255If ctD(I).Ci = 1 Then Se = RGB(255, 255, 0)If ctD(I).Ci > 1 Then Se = ctD(I).SectD(I).Ci = ctD(I).Ci + 1If ctD(I).Ci > 2 Then ctD(I).Ci = 0ElseSe = ctD(I).SeEnd If'画影子Picture1.FillColor = SePicture1.Circle (ctD(I).x * 0.98, ctD(I).y * 0.98), W * 0.8, Se'画一个喷发物Picture1.Circle (ctD(I).x, ctD(I).y), W, Se

NextI:
Next
If S < 1 Then Call Init '所有喷发物已飞出可见区，重新初始化喷发物

Red1:
'画收缩的红球
If ctR >= 1 Then Picture1.FillColor = 255: Picture1.Circle (0, 0), ctR, 255
End Sub