vb怎样做礼花绽放的效果，求程序代码。
发布网友
发布时间：2023-10-30 06:03
共2个回答
热心网友
时间：2024-11-19 07:53
CExplosion.cls文件内容：
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CExplosion"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' CExplosion - Basically a collection of CFrags.
Option Explicit
Private m_Col As Collection
Private m_hDC As Long
' X and Y are the start position.
' How many frags do you want?
Public Sub Setup(x As Single, y As Single, FragCount As Integer, Gravity As Single, hDC As Long)
Dim i As Integer
Dim frag As CFrag
Dim Direction As Single, vel As Single
Set m_Col = New Collection
For i = 1 To FragCount
Set frag = New CFrag
Direction = Rnd * (2 * pi)
vel = (Rnd * 20) + 10
frag.Init x, y, Direction, vel, Gravity
m_Col.Add frag
Next i
m_hDC = hDC
End Sub
' Move and draw the frags.
Public Function Move() As Boolean
Dim frag As CFrag
Dim DeadCount As Integer
For Each frag In m_Col
With frag
If Not .Move Then DeadCount = DeadCount + 1
Ellipse m_hDC, .x - 2, .y - 2, .x + 1, .y + 1
End With
Next frag
Move = Not (DeadCount = m_Col.Count)
End Function
CFrag.cls文件内容：
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CFrag"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' CFrag - Represents a flying object with velocity and direction.
' From this it can work out a path of co-ordinates.
' Basic trigonometry is used.
Option Explicit
Private m_Direction As Single ' In Radians.
Private m_Velocity As Single
Private m_Gravity As Single ' Make it fall towards bottom of screen.
Private m_X As Single, m_Y As Single
' Setup the object.
Public Sub Init(XStart As Single, YStart As Single, Direction As Single, Velocity As Single, Gravity As Single)
m_Direction = Direction
m_Velocity = Velocity
m_Gravity = Gravity
m_X = XStart
m_Y = YStart
End Sub
' Move the object along its path.
Public Function Move() As Boolean
m_Velocity = m_Velocity - 1 ' Decrease speed.
If m_Velocity > 0 Then
m_X = m_X + (m_Velocity * Cos(m_Direction))
m_Y = m_Y + (m_Velocity * Sin(m_Direction)) + m_Gravity
Move = True
' Else it has stopped.
End If
End Function
Public Property Get x() As Single
x = m_X
End Property
Public Property Get y() As Single
y = m_Y
End Property
CTrail.cls文件内容：
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CTrail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' CTrail - Display a trail of dots for a set length.
Option Explicit
Private m_Direction As Single
Private m_Length As Integer
Private m_hDC As Long
Private m_X As Single, m_Y As Single
Public Sub Init(x As Single, y As Single, Direction As Single, Length As Integer, hDC As Long)
m_X = x
m_Y = y
m_Direction = Direction
m_Length = Length
m_hDC = hDC
End Sub
Public Function Move() As Boolean
If m_Length > 0 Then
m_Length = m_Length - 1
m_X = m_X + 10 * Cos(m_Direction)
m_Y = m_Y + 10 * Sin(m_Direction)
Sparkle m_X, m_Y
Move = True
Else
Move = False
End If
End Function
' Draw a random splatter of dots about x,y.
Private Sub Sparkle(x As Single, y As Single)
Dim i As Byte
Dim nX As Single, nY As Single
Dim angle As Single
For i = 1 To (Rnd * 5) + 3
angle = Rnd * (2 * pi)
nX = x + (3 * Cos(angle))
nY = y + (3 * Sin(angle))
Ellipse m_hDC, nX - 1, nY - 1, nX + 1, nY + 1
Next i
End Sub
Public Property Get x() As Single
x = m_X
End Property
Public Property Get y() As Single
y = m_Y
End Property
frmExplode.frm文件内容：
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
VERSION 5.00
Begin VB.Form frmExplode
Caption = "Form1"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
FillStyle = 0 'Solid
LinkTopic = "Form1"
ScaleHeight = 213
ScaleMode = 3 'Pixel
ScaleWidth = 312
StartUpPosition = 3 'Windows Default
WindowState = 2 'Maximized
Begin VB.CommandButton cmdExit
Caption = "E&xit"
Height = 375
Left = 3000
TabIndex = 2
Top = 2520
Width = 1215
End
Begin VB.CommandButton cmdClear
Caption = "&Clear"
Height = 375
Left = 1680
TabIndex = 1
Top = 2520
Width = 1215
End
Begin VB.PictureBox Picture1
BackColor = &H00000000&
FillStyle = 0 'Solid
Height = 2295
Left = 120
ScaleHeight = 149
ScaleMode = 3 'Pixel
ScaleWidth = 301
TabIndex = 0
Top = 120
Width = 4575
End
Begin VB.Timer tmrMove
Enabled = 0 'False
Interval = 10
Left = 4080
Top = 120
End
End
Attribute VB_Name = "frmExplode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Explosion - Simulate fireworks on your PC. Just click on the black box!
Option Explicit
Private explosion As CExplosion
Private trail As CTrail
Private bExplode As Boolean
Private Sub cmdClear_Click()
Picture1.Cls
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Resize()
' Keep everything looking good.
Dim h As Single
On Error Resume Next
h = ScaleHeight - cmdClear.Height
Picture1.Move 0, 0, ScaleWidth, h
cmdClear.Move 0, h
cmdExit.Move 0 + cmdClear.Width, h
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Not tmrMove.Enabled Then
' Create a new trail...
' Choose a color from a list.
Picture1.ForeColor = Choose(Int(Rnd * 5) + 1, vbRed, vbWhite, vbCyan, vbGreen, vbYellow)
Picture1.FillColor = Me.ForeColor
Set trail = New CTrail
' Choose random direction from 255 to 344
trail.Init x, y, Radians(Int(Rnd * 90) + 225), Int(Rnd * 30) + 20, Picture1.hDC
tmrMove.Enabled = True ' Timer will handle drawing.
End If
End Sub
Private Sub tmrMove_Timer()
' Note that the move functions also draw.
' They return false when the object no longer is moving.
If trail.Move = False And bExplode = False Then
' The trail has stopped so explode.
bExplode = True
Set explosion = New CExplosion
explosion.Setup trail.x, trail.y, Int(Rnd * 30) + 10, 9, Picture1.hDC
End If
If bExplode Then
If explosion.Move = False Then
' Reset for a new explosion!
tmrMove.Enabled = False
bExplode = False
End If
End If
End Sub
' Simple function to convert degrees to radians.
Private Function Radians(sngDegrees As Single) As Single
Radians = sngDegrees * pi / 180
End Function
modStuff.bas文件内容：
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Attribute VB_Name = "modStuff"
Option Explicit
' To get Pi type "? 4 * Atn(1)" in the immediate window,
' copy the result into code!
Public Const pi = 3.14159265358979
Public Declare Function Ellipse Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
热心网友
时间：2024-11-19 07:53
