線に沿う玉の運動を描く⑦ いろいろやる前にカプセル化
これの続きです。
chemiphys.hateblo.jp
速度に法則を適用するのが難しく,頭を悩ませています。
エネルギー保存則を入れたかったんだけど,いろいろと難しかったので,ちょっと違う方向で動きをつけようとしています。
きっとなんとかしようとは思ってます。
とりあえず,前回反省であった,変数が足りなくなる問題。
Publicでなんでも垂れ流しているので,それはそうですよね。。
いろいろ考えてたどり着いたのはClassのメソッドやプロパティはメンバから簡単に選べるので,そこには日本語も積極的に活用しよう。
引数もタイピングする必要の少ないものだから,引数の文字も場合によっては日本語の利用もする。
内部で何度も書いたりする内容については,プライベートやプロパティの気持ちをこめてpを変数名につけていく
このくらいのイメージを頭に持って,昨日までのコードを書きなおしました。
あと,沈まない工夫については,複雑な判定をもう一度するのではなく,重複部分を判断させる図形のHeight,Widthプロパティから大きさを判断し,ある程度の大きさを超えたらそれを打ち消すべく
座標をほんの少しずつずらす。イメージとしては抗力的な感じです。Height,Width両方あれば,いろんな判断をさせられるかなーと思い実装しました。
動きは変ですが,今日のコードとその動きを載せます。
さぁ動きに法則っぽさを足していこう。
標準モジュール
Option Explicit Public Const Rate As Currency = 1 Const SID = 1 Sub Test() Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(SID) Dim Ball1 As Ball: Set Ball1 = New Ball Dim shpSlope As Shape: Set shpSlope = TSlide.Shapes("slope") ActivePresentation.SlideShowSettings.Run Dim Y0 As Long: Y0 = 60 Ball1.Draw TSlide, 40, RGB(255, 255, 0), 15, Y0 Do Ball1.Move TSlide, shpSlope, Y0 Ball1.BallTxt " " DoEvents Loop Until Ball1.X > 800 End Sub
Ball.cls
Option Explicit Private pVx As Currency Private pVy As Currency Private pV As Currency Private shpBall As Shape Const Gravity = 9.8 Public Sub BallTxt(txtBall As String) shpBall.TextFrame.TextRange = txtBall End Sub Public Property Get Vx() As Currency Vx = pVx End Property Public Property Get Vy() As Currency Vy = pVy End Property 'Public Property Let V(速度 As Currency) ' pV = 速度 'End Property Public Property Get V() As Currency V = pV End Property Public Property Get X() As Currency X = shpBall.Left End Property Public Property Let X(X座標 As Currency) shpBall.Left = X座標 End Property Public Property Let Y(Y座標 As Currency) shpBall.Top = Y座標 End Property Sub Draw(pSlide As Slide, 直径 As Long, 色 As Long, pX As Long, pY As Long) Set shpBall = pSlide.Shapes.AddShape(msoShapeOval, pX, pY, 直径, 直径) shpBall.Fill.ForeColor.RGB = 色 shpBall.Line.ForeColor.RGB = RGB(0, 0, 0) shpBall.Line.Weight = 2 End Sub Sub Move(pSlide As Slide, pShpCollide As Shape, pY0 As Long) Dim 判定 As Hantei: Set 判定 = New Hantei 判定.Judge pSlide, shpBall, pShpCollide 'pV = (-2 * Gravity * pY0 / 27 + pV0 ^ 2 + 2 * Gravity * shpBall.Top / 27) ^ 0.5 pV = 3 If 判定.blnCollide = True Then pVx = pV * Cos(判定.sglAngle) * Rate pVy = pV * Sin(判定.sglAngle) * Rate + 1 * Sin(判定.sglAngle) * Rate If 判定.重なり高さ > 1 Then shpBall.Top = shpBall.Top - 1 Else pVx = 0 pVy = pV * Rate End If shpBall.Left = shpBall.Left + pVx shpBall.Top = shpBall.Top + pVy End Sub
Hantei.cls
Option Explicit Private psglAngle As Single Private pblnCollide As Boolean Private shpDupeHeight As Long Private shpDupeWidth As Long Public Property Get sglAngle() sglAngle = psglAngle End Property Public Property Get blnCollide() blnCollide = pblnCollide End Property Public Property Get 重なり幅() 重なり幅 = shpDupeWidth End Property Public Property Get 重なり高さ() 重なり高さ = shpDupeHeight End Property Sub Judge(hSlide As Slide, shp1 As Shape, shp2 As Shape) Dim lngShapeCount As Long Dim NextShp1 As Shape lngShapeCount = hSlide.Shapes.Count hSlide.Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition)).Duplicate.MergeShapes msoMergeIntersect If hSlide.Shapes.Count = lngShapeCount Then pblnCollide = False Exit Sub Else pblnCollide = True Dim shpDupe As Shape Set shpDupe = hSlide.Shapes(hSlide.Shapes.Count) End If Dim shpNodes As ShapeNodes: Set shpNodes = shpDupe.Nodes Dim sglMinPtX As Single: sglMinPtX = shpNodes(1).Points(1, 1) Dim MinPtXIndex As Long: MinPtXIndex = 1 Dim i As Long For i = 1 To shpNodes.Count - 1 If shpNodes(i).Points(1, 1) < sglMinPtX Then sglMinPtX = shpNodes(i).Points(1, 1) MinPtXIndex = i End If Next Dim NextPtXIndex As Long If shpNodes(MinPtXIndex + 1).Points(1, 1) - shpNodes(MinPtXIndex).Points(1, 1) < 2 And MinPtXIndex + 2 <= shpNodes.Count Then NextPtXIndex = MinPtXIndex + 2 Else NextPtXIndex = MinPtXIndex + 1 End If If shpNodes(NextPtXIndex).Points(1, 1) - shpNodes(MinPtXIndex).Points(1, 1) > 0.1 Then psglAngle = Atn((shpNodes(NextPtXIndex).Points(1, 2) - shpNodes(MinPtXIndex).Points(1, 2)) / (shpNodes(NextPtXIndex).Points(1, 1) - shpNodes(MinPtXIndex).Points(1, 1))) Else psglAngle = 3.14 / 2 End If shpDupeHeight = shpDupe.Height shpDupeWidth = shpDupe.Width shpDupe.Delete End Sub