|
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Const GRAVITY = 20
Private Const PI = 3.1415
Private Const PIby2 = PI * 2
Private Const PIdiv180 = PI / 180
Private Type tParticle
x As Single
y As Single
xm As Single
ym As Single
colorref As Byte
End Type
Private Particle() As tParticle
Private ExplosionTime As Long
Private Exploded As Boolean
Private EndTime As Long
Private Color1 As Long
Private Color2 As Long
Private Brightness As Single
Private ExplosionPower As Single
Private Farbe24bit As cRGB
Private Farbe16bit1 As cRGB
Private Farbe16bit2 As cRGB
Private Sub Class_Initialize()
ReDim Particle(0)
End Sub
Sub Fire(x As Single, y As Single, Angle As Single, Speed _
As Single, ExplodePower As Single, NumParticles As Long, _
ExplodeTime As Long, FadeTime As Long)
On Error Resume Next
Dim l As Long
NumParticles = NumParticles - 1
ReDim Particle(0 To NumParticles)
For l = 0 To NumParticles
With Particle(l)
.colorref = Int(Rnd * 2) + 1
.x = x + Rnd * 2 - 1
.y = y + Rnd * 2 - 1
.xm = Sin(Angle) * Speed
.ym = Cos(Angle) * Speed
End With
Next
Farbe24bit.r = Rnd * 35 + 220
Farbe24bit.g = Rnd * 155 + 100
Farbe24bit.b = Rnd * 155 + 100
Color1 = To16bit(Farbe24bit)
Farbe24bit.r = Rnd * 35 + 220
Farbe24bit.g = Rnd * 155 + 100
Farbe24bit.b = Rnd * 155 + 100
Color2 = To16bit(Farbe24bit)
ExplosionTime = timeGetTime() + ExplodeTime
EndTime = ExplosionTime + FadeTime
ExplosionPower = ExplodePower
Exploded = False
Brightness = 1
l = Int(Rnd * 3) + 1
RocketSound(l).Play DSBPLAY_DEFAULT
End Sub
Sub Move(TimeElapsed As Long)
Dim l As Long
Dim t As Single
t = TimeElapsed / 1000
On Error Resume Next
For l = 0 To UBound(Particle)
With Particle(l)
.x = .x + .xm * t
.ym = .ym + GRAVITY * t
.y = .y + .ym * t
End With
Next
Dim Now As Long
Now = timeGetTime()
If Exploded Then
Brightness = _
1 - (Now - ExplosionTime) / (EndTime - ExplosionTime)
Else
If Now > ExplosionTime Then Explode
End If
If Now > EndTime Then
Dim Spd As Single
Spd = Rnd * 120 + 50
Fire Rnd * 640, 480, PI + (Rnd - 0.5) / _
2, Spd, Rnd * 30 + 30, Rnd * 100 + 50, 300000 / _
Spd, Rnd * 5000 + 5000
End If
End Sub
Sub Draw()
Dim l As Long
Dim x As Integer
Dim y As Integer
Dim BackColor As Long
Dim ForeColor As Long
Dim Dark As Single
Dim Bright As Single
On Error Resume Next
If Exploded Then
For l = 0 To UBound(Particle)
With Particle(l)
Select Case .x
Case 4 To 636
Select Case .y
Case 4 To 476
If .colorref = 1 Then _
ForeColor = Color1 Else ForeColor = Color2
Farbe16bit1 = GetRGB16(ForeColor)
BackColor = Backbuffer.GetLockedPixel(.x, .y)
Farbe16bit2 = GetRGB16(BackColor)
Dark = 1 - Brightness
Farbe16bit1.r = _
Farbe16bit1.r * Brightness + _
Farbe16bit2.r * Dark
Farbe16bit1.g = _
Farbe16bit1.g * Brightness + _
Farbe16bit2.g * Dark
Farbe16bit1.b = Farbe16bit1.b * Brightness + _
Farbe16bit2.b * Dark
Backbuffer.SetLockedPixel .x, .y, _
Get16BitColor(Farbe16bit1)
Bright = Brightness * 0.5
Dark = 1 - Bright
Farbe16bit1.r = _
Farbe16bit1.r * Bright + _
Farbe16bit2.r * Dark
Farbe16bit1.g = Farbe16bit1.g * Bright + _
Farbe16bit2.g * Dark
Farbe16bit1.b = Farbe16bit1.b * Bright + _
Farbe16bit2.b * Dark
Backbuffer.SetLockedPixel .x + 1, .y, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 1, .y, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x, .y + 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x, .y - 1, _
Get16BitColor(Farbe16bit1)
Bright = Brightness * 0.25
Dark = 1 - Bright
Farbe16bit1.r = Farbe16bit1.r * Bright + _
Farbe16bit2.r * Dark
Farbe16bit1.g = Farbe16bit1.g * Bright + _
Farbe16bit2.g * Dark
Farbe16bit1.b = Farbe16bit1.b * Bright + _
Farbe16bit2.b * Dark
Backbuffer.SetLockedPixel .x + 1, .y + 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 1, .y - 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 1, .y + 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 1, .y - 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 2, .y, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 2, .y, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x, .y + 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x, .y - 2, _
Get16BitColor(Farbe16bit1)
Bright = Brightness * 0.125
Dark = 1 - Bright
Farbe16bit1.r = Farbe16bit1.r * Bright + _
Farbe16bit2.r * Dark
Farbe16bit1.g = Farbe16bit1.g * Bright + _
Farbe16bit2.g * Dark
Farbe16bit1.b = Farbe16bit1.b * Bright + _
Farbe16bit2.b * Dark
Backbuffer.SetLockedPixel .x + 2, .y + 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 2, .y - 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 2, .y + 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 2, .y - 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 2, .y + 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 2, .y - 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 2, .y + 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 2, .y - 1, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 1, .y + 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 1, .y - 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 1, .y + 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 1, .y - 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 3, .y, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 3, .y, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x, .y + 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x, .y - 3, _
Get16BitColor(Farbe16bit1)
Bright = Brightness * 0.612
Dark = 1 - Bright
Farbe16bit1.r = Farbe16bit1.r * Bright + _
Farbe16bit2.r * Dark
Farbe16bit1.g = Farbe16bit1.g * Bright + _
Farbe16bit2.g * Dark
Farbe16bit1.b = Farbe16bit1.b * Bright + _
Farbe16bit2.b * Dark
Backbuffer.SetLockedPixel .x + 2, .y + 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 2, .y - 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 2, .y + 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 2, .y - 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 3, .y + 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 3, .y - 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 3, .y + 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 3, .y - 2, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 4, .y + 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 4, .y - 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 4, .y + 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 4, .y - 3, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 3, .y + 4, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x + 3, .y - 4, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 3, .y + 4, _
Get16BitColor(Farbe16bit1)
Backbuffer.SetLockedPixel .x - 3, .y - 4, _
Get16BitColor(Farbe16bit1)
End Select
End Select
End With
Next
Else
For l = 0 To UBound(Particle)
With Particle(l)
Select Case .x
Case 0 To 640
Select Case .y
Case 0 To 480
If Int(Rnd * 2) Then _
ForeColor = Color1 Else ForeColor = Color2
Backbuffer.SetLockedPixel .x, .y, ForeColor
End Select
End Select
End With
Next
End If
End Sub
Private Sub Explode()
On Error Resume Next
Dim l As Long
Dim Angle As Single
If Exploded Then Exit Sub
l = Int(Rnd * 3) + 1
ExplodeSound(l).Play DSBPLAY_DEFAULT
For l = 0 To UBound(Particle)
With Particle(l)
Angle = Rnd * PIby2
.xm = .xm + (Sin(Angle) * Rnd * ExplosionPower)
.ym = .ym + (Cos(Angle) * Rnd * ExplosionPower)
End With
Next
Exploded = True
End Sub
|
|