ShpClsに速度と加速度の概念を追加してみた
つづきです。
chemiphys.hateblo.jp
クラスモジュールは本当に面白いです。いろいろとチャレンジしがいがある。
物体に速度と加速度の概念を付け加えるという作業をしました。
なかなか苦労しましたが,想定通りの動きをしだしました。
物体自身に速度と加速度を持たせ,Moveメソッドで逐次変化していくようになっています。
加速度固定の例ですが,変化させていくこともできる・・つもり。。
標準モジュール 今回はシェイプを作るようにしていますので,事前準備はいりません。
Option Explicit Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) Const PI = 3.1415 Sub MoveTest() ActivePresentation.SlideShowSettings.Run Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1) Dim s As ShpCls: Set s = New ShpCls TSlide.Shapes.Range.Delete With TSlide.Shapes.AddShape(msoShapeSun, 30, 100, 30, 30) .Name = "shp" .Fill.ForeColor.RGB = vbYellow End With Dim shp As Shape: Set shp = TSlide.Shapes("shp") s.SetShp shp s.SetA 0.3, PI / 2 s.SetV 10, -PI / 4 Dim i As Long Do s.Move shp.TextFrame.TextRange = " " DoEvents Sleep 10 If s.x > 960 Then Exit Do If s.y > 540 Then Exit Do i = i + 1 Loop SlideShowWindows(1).View.Exit End Sub
ShpCls.cls
SetV以降を今回追加しています。
Moveメソッドで,その段階での速度を追加して移動し,その後加速度分,速度を変化させます。
速度の大きさ,角度が変わりますので,角度の再計算等を行い新しい値を収める。
(追記 速度角度を標準モジュールから取得できるようにプロパティを追加)
Option Explicit Const PI = 3.1415 Private pShp As Shape Private pV As Currency Private pVAngle As Currency Private pA As Currency Private pAAngle As Currency Public Sub SetShp(図形 As Shape) Set pShp = 図形 End Sub Property Get x() As Currency x = pShp.Left + pShp.Width / 2 End Property Property Let x(X座標 As Currency) pShp.Left = X座標 - pShp.Width / 2 End Property Property Get y() As Currency y = pShp.Top + pShp.Height / 2 End Property Property Let y(Y座標 As Currency) pShp.Top = Y座標 - pShp.Height / 2 End Property Property Get Left() As Currency Left = pShp.Left End Property Property Let Left(pLeft As Currency) pShp.Left = pLeft End Property Property Get Right() As Currency Right = pShp.Left + pShp.Width End Property Property Let Right(pRight As Currency) pShp.Left = pRight - pShp.Width End Property Property Get Top() As Currency Top = pShp.Top End Property Property Let Top(pTop As Currency) pShp.Top = pTop End Property Property Get Bottom() As Currency Bottom = pShp.Top + pShp.Height End Property Property Let Bottom(pBottom As Currency) pShp.Top = pBottom - pShp.Height End Property Public Sub Delete() pShp.Delete End Sub Public Sub SetV(速度 As Currency, 速度角度 As Currency) pV = 速度 pVAngle = 速度角度 End Sub Public Sub SetA(加速度 As Currency, 加速度角度 As Currency) pA = 加速度 pAAngle = 加速度角度 End Sub Property Get 速度角度() As Currency 速度角度 = pVAngle End Property Public Sub Move() Me.x = Me.x + pV * Cos(pVAngle) Me.y = Me.y + pV * Sin(pVAngle) pV = Sqr((pV * Cos(pVAngle) + pA * Cos(pAAngle)) ^ 2 + (pV * Sin(pVAngle) + pA * Sin(pAAngle)) ^ 2) pVAngle = Angle(pV * Cos(pVAngle) + pA * Cos(pAAngle), pV * Sin(pVAngle) + pA * Sin(pAAngle)) End Sub Function Angle(x As Currency, y As Currency) Dim pHosei As Currency If Abs(x) < 0.001 Then If y > 0 Then Angle = PI / 2 ElseIf y < 0 Then Angle = -PI / 2 Else Angle = PI / 2 '(;´▽`A`` End If Else If x > 0 Then If y >= 0 Then pHosei = 0 Else pHosei = 2 * PI Else If y >= 0 Then pHosei = PI Else pHosei = PI End If Angle = Atn(y / x) End If Angle = Angle + pHosei End Function
追記
回転運動ぽいのができるかなぁと思い,ちょっと速度角度というプロパティを足した後,次のように標準モジュールを書き換えました。
一部分のみ載せています。 加速度を与えるSetAをループの中に入れた。
Dim shp As Shape: Set shp = TSlide.Shapes("shp") s.SetShp shp s.SetV 10, -PI / 2 Dim i As Long Do s.SetA 0.8, s.速度角度 - PI / 2 s.Move shp.TextFrame.TextRange = " "
このようになります。
等速円運動の話とか覚えてないので,ずっと回るように半径を決める術はわたしにはありませんが,
なんとなくそれができそうな動きをしているので,喜びました。