波をVBAで描く方法 Collectionで各点の値を保持 - インストールレスプログラミング( ´ー`)

また明日から忙しいんですが，波動をやろうというのはあきらめていません。

まぁ悩んでてうまいこと答えがしばらく出せていませんでした。

配列に波のポイントを入れようと思っていたわけですが，次々に始点のほうに値を追加する形でポイントを追加していかないと，波が逆行します。

以前配列で作ったときはそれに気づいていませんでしたが，配列は後に後に追加するんですが，波は波源の変位を常に最初のポイントに追加し，スライドしていかないといけない。

で，それを最初はShapeNodeでやっていたんですが，極めて重くなっていくので無理だったんです。

最初に追加するねぇ・・・と一回一回配列の中身をインデックスを１追加したものに放り込んでずらしておいて，インデックス１のところに波源の値を入れるかぁとか考えていました。

今日，職場でちょっとVBAHandBookを眺めていて，こんな文章がありました。

VBA provides two built-in data structures:arrays and collections.
Each has its good and bad points,
and there are compelling reasons to use each of these structures.
(VBA DEVELOPER'S HANDBOOK Second Edition p.432)

この短いフレーズなら著作権問題ない・・と思う。

Chapter 6: Creating Dynamic Data Structures Using Class Modules
ちょうど，この部分についてはMSDNに少しのってましたので，リンク貼っておきます。検索で出てきた。

compelling reasons っていう言い回しがカッコイイナァ!とか思いながら読んでいたんですが，

あぁ　最初に値を追加するとか Collectionなら簡単にデキルジャナイカ!とまたしてもお風呂で気づきました。いつもお風呂(;´▽｀A``

配列に疎いだけで本当はあるのかもしれませんが，とりあえず最初にポイントを追加するという，私にとっての波のイメージに近い方法でばたばたとコレクションを使い組みました。

いつも持ち歩ているSDカードを持って帰り忘れたので，0からどたばた組んだのでコードはひどいですが，まぁ載せます。

見た目はまったく進歩していませんが，中身の考え方が変わっているので，少し進歩した気分です。

Option Explicit
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwmiliseconds As Long)
Const dP As Currency = 2 * 3.1415 / 20
Const StartX As Long = 80
Const StartY As Long = 270
Const dX As Long = 5
Const a As Long = 100
Sub wavetest()
    ActivePresentation.SlideShowSettings.Run
    
    Dim WavePoints As Collection: Set WavePoints = New Collection
    Dim Y As Currency
    
    Dim phase As Currency
    Dim i As Long
    Dim drwWave As FreeformBuilder
    Dim ShpWave As Shape
    Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1)
    Dim Shp波源 As Shape
    TSlide.Shapes.Range.Delete
    
    Set Shp波源 = TSlide.Shapes.AddShape(msoShapeOval, StartX - 5, StartY, 10, 10)
    Shp波源.Fill.ForeColor.RGB = vbRed
    Shp波源.Fill.Visible = msoTrue
    
    Do
        On Error Resume Next
            ShpWave.Delete
        On Error GoTo 0
        Y = a * Sin(phase)
        If WavePoints.Count >= 1 Then
            WavePoints.Add Y, before:=1
        Else
            WavePoints.Add Y
        End If
    
        phase = phase + dP
        If WavePoints.Count = 161 Then WavePoints.Remove 161
        
        If WavePoints.Count >= 2 Then
            Set drwWave = TSlide.Shapes.BuildFreeform(msoEditingAuto, StartX, StartY - WavePoints(1))
            Shp波源.Top = StartY - WavePoints(1) - 5
            For i = 2 To WavePoints.Count
                drwWave.AddNodes msoSegmentLine, msoEditingAuto, StartX + (i - 1) * dX, StartY - WavePoints(i)
            Next
            Set ShpWave = drwWave.ConvertToShape
            ShpWave.Line.Weight = 2
            ShpWave.Line.ForeColor.RGB = vbBlue
        End If
        
        Shp波源.TextFrame.TextRange = " "
        
        DoEvents
        Sleep 50
    Loop
End Sub