図形を描くために④ アニメーションさせるには2
Sinカーブを描くのは以前やりましたので,少しコードを足して動かしてみます。
すごいシンプルです。
書いて消す 書いて消す 書いて消す・・・
(;´▽`A``
テキストを一つ書かせるようにしましょう。これをしないと コマが飛んだり動きがぎこちなかったりします。
ホントカヨと思われる方はコメントを無駄に書かせている部分があるので,そこをコメントアウトしてみてください。
Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwmiliseconds As Long) Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long Sub test() Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1) Dim i As Long, y As Long Dim StartX As Long: StartX = 50 Dim StartY As Long: StartY = 100 Dim dX As Long: dX = 5 Dim dP As Currency: dP = 3.14 / 20 Dim A As Long: A = 100 Dim drwWave As FreeformBuilder, shpWave As Shape Dim k As Long: k = 0 ActivePresentation.SlideShowSettings.Run TSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 300, 300, 50).Name = "停止方法" Do On Error Resume Next TSlide.Shapes("波").Delete On Error GoTo 0 For i = 0 To 100 y = CLng(A * Sin(dP * i - dP * k)) If i = 0 Then Set drwWave = TSlide.Shapes.BuildFreeform(msoEditingAuto, StartX, StartY - y) End If drwWave.AddNodes msoSegmentLine, msoEditingAuto, StartX + i * dX, StartY - y Next Set shpWave = drwWave.ConvertToShape shpWave.Line.ForeColor.RGB = RGB(255, 0, 0) shpWave.Line.Weight = 2 shpWave.Line.DashStyle = msoLineLongDash shpWave.Name = "波" i = i + 1 'テキストを一つ書かせているところ TSlide.Shapes("停止方法").TextFrame.TextRange = "停止させるには,Shiftキーを押してください。" DoEvents If GetAsyncKeyState(vbKeyShift) Then TSlide.Shapes("停止方法").Delete SlideShowWindows(1).View.Exit Exit Sub End If Sleep 50 k = k + 1 Loop End Sub
(いらないフラグがあったので消しました。)
単純極まりない感じです。
こんな感じになります。
粒を動かしてあげたりするときは書いて消しては大変かと思いますが,関数を書かせてパラメーターで動かす分には,
これで十分かと思っています。(ΦωΦ)