VB实现点爆炸效果
创始人
2024-06-01 11:55:53
0

在这里插入图片描述
'需在窗体放置以下 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

相关内容

热门资讯

AWSECS:访问外部网络时出... 如果您在AWS ECS中部署了应用程序,并且该应用程序需要访问外部网络,但是无法正常访问,可能是因为...
AWSElasticBeans... 在Dockerfile中手动配置nginx反向代理。例如,在Dockerfile中添加以下代码:FR...
AWR报告解读 WORKLOAD REPOSITORY PDB report (PDB snapshots) AW...
AWS管理控制台菜单和权限 要在AWS管理控制台中创建菜单和权限,您可以使用AWS Identity and Access Ma...
北信源内网安全管理卸载 北信源内网安全管理是一款网络安全管理软件,主要用于保护内网安全。在日常使用过程中,卸载该软件是一种常...
​ToDesk 远程工具安装及... 目录 前言 ToDesk 优势 ToDesk 下载安装 ToDesk 功能展示 文件传输 设备链接 ...
Azure构建流程(Power... 这可能是由于配置错误导致的问题。请检查构建流程任务中的“发布构建制品”步骤,确保正确配置了“Arti...
群晖外网访问终极解决方法:IP... 写在前面的话 受够了群晖的quickconnet的小水管了,急需一个新的解决方法&#x...
不能访问光猫的的管理页面 光猫是现代家庭宽带网络的重要组成部分,它可以提供高速稳定的网络连接。但是,有时候我们会遇到不能访问光...
AWSECS:哪种网络模式具有... 使用AWS ECS中的awsvpc网络模式来获得最佳性能。awsvpc网络模式允许ECS任务直接在V...