インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

熱運動クラスモジュール化①

いろいろなものを並列してやってます。せっかく動いた斜面のやつも興味は尽きませんが,ちょっと置いて熱運動のやつでクラスモジュール化の練習。

chemiphys.hateblo.jp

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

こんな感じになります。粒は同じ座標にできてしまうので,手動でちょいずらしました。領域内にランダムで生成するようにしてもいいな それも面白い。
f:id:chemiphys:20170115175840p:plain

プロパティが多く,標準モジュールもごちゃっとしてますが,確実に分離はできているので,面白くはあります。
これ動かしきれるのかな?(ΦωΦ)Publicで宣言してるから,アクセスはできるはずだけど・・

まず第一歩目です。

名前を決めているところがごちゃっとしてるけど,うまい方法が思いつかない。(;´▽`A``