VB Realizes Point Explosion Effect

insert image description here
'The following 4 controls need to be placed on the form, and all controls do not need to set any properties, and use the default settings:
' 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 = "Big Bang - Demo"
Command1.Caption = "Start Demo"
Check1.Caption = "Blink Light"
Timer1.Enabled = False
End Sub

Private Sub Command1_Click()
Dim nStr As String

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

End Sub

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

Picture1.FillStyle = 0
Picture1.BackColor = &H330000
Picture1.AutoRedraw = True

ctR = Picture1.ScaleWidth * 0.5 '红球收缩前的初始半径
ctDs = 1000
ReDim ctD(ctDs)    '初始化喷发物，ctDs 表示总个数

Randomize
For I = 1 To ctDs
    J = 3.1415926 * 2 * Rnd
    V = 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 * 2

T = 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()
'Display the instantaneous state of a blast
Dim I As Long, S As Long, Se As Long
Dim W As Single, W1 As Single, H1 As Single

Picture1.Cls

ctR = ctR * 0.9            '减小红球半径
If ctR > 10 Then GoTo Red1 '爆炸前，只显示收缩的红球
W1 = Picture1.ScaleWidth * 0.5
H1 = Picture1.ScaleHeight * 0.5

For I = 1 To ctDs
    '得到喷发物 ctD(I) 的新位置，并加速 2%
    ctD(I).x = ctD(I).x + ctD(I).toX
    ctD(I).y = ctD(I).y + ctD(I).toY
    ctD(I).toX = ctD(I).toX * 1.02
    ctD(I).toY = ctD(I).toY * 1.02

    '判断喷发物是否飞出可见区
    If ctD(I).x < -W1 Or ctD(I).x > W1 Then GoTo NextI
    If ctD(I).y < -H1 Or ctD(I).y > H1 Then GoTo NextI

    S = S + 1 '计数可见喷发物的个数
    W = 0.02 * Sqr((ctD(I).x) ^ 2 + (ctD(I).y) ^ 2) '根据与中心点的距离确定喷发物的大小
    If Check1.Value = 1 Then
        If ctD(I).Ci = 0 Then Se = 255
        If ctD(I).Ci = 1 Then Se = RGB(255, 255, 0)
        If ctD(I).Ci > 1 Then Se = ctD(I).Se
        ctD(I).Ci = ctD(I).Ci + 1
        If ctD(I).Ci > 2 Then ctD(I).Ci = 0
    Else
        Se = ctD(I).Se
    End If

    '画影子
    Picture1.FillColor = Se
    Picture1.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 'All eruptions have flown out of the visible area, re-initialize eruptions

Red1:
'Draw a shrinking red ball
If ctR >= 1 Then Picture1.FillColor = 255: Picture1.Circle (0, 0), ctR, 255
End Sub

VB Realizes Point Explosion Effect

Guess you like