VBAで花火もどき - t-hom’s diary

こちらの記事に触発されて、あ、そういえばVBAでもパーティクルうまく使えば花火っぽいことできるかなぁと思ってやってみた。
karaage.hatenadiary.jp

結果。。超絶劣化~~コピー~~(間違えた、もはや別物)が爆誕。

実際作って気づいたんだけど、これちゃんとやろうとすると球面上で三角関数を使った計算だったり、重力計算したりと色々とやらないとそれっぽい花火にはならない。

コード

注) お遊びなので変数宣言もしてません。良識のある大人は実務コードにおいてこんな真似しないように。。

Particle クラス

Private Declare Function ColorHLSToRGB Lib "Shlwapi.dll" _
    (ByVal wHue As Integer, _
    ByVal wLuminance As Integer, _
    ByVal wSaturation As Integer) As Long

Private p As Shape
Public angle As Long
Private h As Long
Private l As Long
Private s As Long

Public Property Get Self() As Object
    Set Self = Me
End Property

Private Property Get Radians() As Double
    Radians = angle / 45 * Atn(1)
End Property

Private Sub Class_Initialize()
    Set p = Screen.Shapes.AddShape(msoShapeOval, 0, 0, 0, 0)
    p.Line.Visible = msoFalse
    p.Width = 7
    p.Height = p.Width
    p.Top = 150 - p.Width / 2
    p.Left = 150 - p.Height / 2
End Sub

Public Sub SetColorByHLS(hue, luminance, saturation)
    h = hue
    l = luminance
    s = saturation
    p.Fill.ForeColor.RGB = ColorHLSToRGB(h, l, s)
End Sub

Public Sub Brighter(b)
    l = l + b
    p.Fill.ForeColor.RGB = ColorHLSToRGB(h, l, s)
End Sub

Public Sub Move(d)
    x = Cos(Radians) * d
    y = Sin(Radians) * d
    p.IncrementLeft x
    p.IncrementTop y
End Sub

Private Sub Class_Terminate()
    p.Delete
End Sub

標準モジュールのメインプロシージャ

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Hoge()
    Dim particles As Collection
    Set particles = New Collection
    
    Dim p As Particle
    For k = 10 To 240 Step 30
        For j = 1 To 10
            If j < 5 Then
                For i = 0 To 350 Step 10
                    With New Particle
                        .angle = i
                        .SetColorByHLS k, luminance, 224
                        particles.Add .Self
                    End With
                Next
            End If
            Application.ScreenUpdating = False
            For Each p In particles
                p.Brighter 20
                p.Move 10
            Next
            Application.ScreenUpdating = True
            DoEvents
            Sleep 10
        Next
        Sleep 500
        Do While particles.Count > 0
            particles.Remove 1
        Loop
    Next
End Sub

構造

Particleクラスの初期化時に色とか角度を持たせており、p.Brighter命令で輝度をUp、p.Move命令で設定した角度の方向にParticleを移動させている。
一応、後から生成されたParticleが内から外へ移動しているんだけど、等速直線運動で前のParticleの軌跡にピッタリとはまるので実際のところ動いてるのかどうかすら見た目からは分からないという残念な出来になった。

まぁもともとVBAの限界によってどのみちこれ以上フレームレートは上げられないし、パーティクルを増やせばさらに遅くなる。
本格的にパーティクルアニメーションやるならやっぱProcessing一択だなぁ。

VBAのクラスモジュール学習のテーマとしては割と良いのではと思った。

以上