熱運動クラスモジュール化①
いろいろなものを並列してやってます。せっかく動いた斜面のやつも興味は尽きませんが,ちょっと置いて熱運動のやつでクラスモジュール化の練習。
thomさんから頂いたアドバイスを形にしてみている。
まとめて書いてしまったら,自分もやってみようかなぁという人の役には立たないので,ゆっくりいきます。
なかなか思い通りにはいかなくて悪戦苦闘中ですがタノシイデスヨ。
とりあえず今はここまで。
Molecule.cls Option Explicit Public pSlide As Slide Public pVx As Long Public pVy As Long Public mLeft As Long '動く領域左端 Public mRight As Long '動く領域右端 Public mTop As Long ''動く領域上端 Public mBottom As Long '動く領域下端 Public Sub Add(半径 As Long) Dim shpEn As Shape Set shpEn = pSlide.Shapes.AddShape(msoShapeOval, (mLeft + mRight) / 2, (mTop + mBottom) / 2, 半径, 半径) shpEn.Fill.ForeColor.RGB = RGB(Int(255 * Rnd()), Int(255 * Rnd()), Int(255 * Rnd())) shpEn.ThreeD.BevelTopDepth = 半径 / 2 shpEn.ThreeD.BevelTopInset = 半径 / 2 shpEn.Line.Visible = msoFalse Dim x As Shape Dim 粒ID As Long: 粒ID = 0 If pSlide.Shapes.Count <> 0 Then For Each x In pSlide.Shapes If Left(x.Name, 1) = "粒" And IsNumeric(Mid(x.Name, 2)) Then If CLng(Mid(x.Name, 2)) > 粒ID Then 粒ID = CLng(Mid(x.Name, 2)) End If Next 粒ID = 粒ID + 1 End If shpEn.Name = "粒" & Format(粒ID, "00") End Sub
Box.cls Option Explicit Public pSlide As Slide Public pTop As Long Public pBottom As Long Public pLeft As Long Public pRight As Long Public pSpeed As Long Public Sub Draw() If IsEmpty(pSlide) Or IsEmpty(pTop) Or IsEmpty(pBottom) Or IsEmpty(pLeft) Or IsEmpty(pRight) Then Exit Sub Dim Box As Shape Set Box = pSlide.Shapes.AddShape(msoShapeRectangle, pLeft, pTop, pRight - pLeft, pBottom - pTop) Dim x As Shape Dim BoxID As Long: BoxID = 0 If pSlide.Shapes.Count <> 0 Then For Each x In pSlide.Shapes If Left(x.Name, 3) = "Box" And IsNumeric(Mid(x.Name, 4)) Then If CLng(Mid(x.Name, 4)) > BoxID Then BoxID = CLng(Mid(x.Name, 4)) End If Next BoxID = BoxID + 1 End If Box.Name = "Box" & BoxID Box.Line.Visible = msoTrue Box.Line.Weight = 6 Box.Line.ForeColor.RGB = RGB(0, 0, 0) Box.Fill.Visible = msoFalse Dim Label As Shape Set Label = pSlide.Shapes.AddShape(msoShapeRoundedRectangle, pLeft, pBottom + 10, pRight - pLeft, 20) Label.Name = "Spd" & BoxID Label.TextFrame.TextRange = pSpeed End Sub Public Sub AddMolecile(粒数 As Long) Dim e() As Molecule: ReDim e(粒数) Dim i As Long For i = 1 To 粒数 Set e(i) = New Molecule e(i).mLeft = pLeft e(i).mTop = pTop e(i).mRight = pRight e(i).mBottom = pBottom Set e(i).pSlide = pSlide e(i).Add 15 Next End Sub
標準モジュール Option Explicit Sub test() Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1) Dim B1 As Box Set B1 = New Box B1.pLeft = 80: B1.pTop = 100: B1.pRight = 150: B1.pBottom = 250 Set B1.pSlide = TSlide B1.Draw B1.AddMolecile 5 End Sub
こんな感じになります。粒は同じ座標にできてしまうので,手動でちょいずらしました。領域内にランダムで生成するようにしてもいいな それも面白い。
プロパティが多く,標準モジュールもごちゃっとしてますが,確実に分離はできているので,面白くはあります。
これ動かしきれるのかな?(ΦωΦ)Publicで宣言してるから,アクセスはできるはずだけど・・
まず第一歩目です。
名前を決めているところがごちゃっとしてるけど,うまい方法が思いつかない。(;´▽`A``