【Word VBA】ヒルベルト曲線描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Const cns_intLnLn = 10            '描画線の長さ(定数)

Public p_intCptX As Integer       '描画位置Ｘ(変数)

Public p_intCptY As Integer       '　　　　Ｙ(変数)

Public p_intCAng As Integer      '描画方向　(変数)

Public Sub ヒルベルト曲線描画マクロ()

    Const HLBTLEFT = 100         '描画開始位置Ｘ

    Const HLBTTOPP = 220         '　　　　　　Ｙ

    '

    Const HLBTORDR = 4 '次数

    '

    p_intCptX = HLBTLEFT

    p_intCptY = HLBTTOPP: p_intCAng = 0

    Call Sヒルベルト曲線描画マクロ_再帰(HLBTORDR, 90)

End Sub

Public Sub Sヒルベルト曲線描画マクロ_再帰(pintNo As Integer, pintAn As Integer)

    Const HLBTLCOL = &H4763FF '線の色(TOMATO)

    Const HLBTLWEI = 1.5 '線の太さ

    '---------------------------------------------------------------------------

    Dim intPtX As Integer, intPtY As Integer, intAng As Integer

    '

    If pintNo > 0 Then

       p_intCAng = p_intCAng + pintAn

       Call Sヒルベルト曲線描画マクロ_再帰(pintNo - 1, pintAn * -1)

       GoSub ヒルベルト曲線描画マクロ_DRAW

       p_intCAng = p_intCAng - pintAn

       Call Sヒルベルト曲線描画マクロ_再帰(pintNo - 1, pintAn)

       GoSub ヒルベルト曲線描画マクロ_DRAW

       Call Sヒルベルト曲線描画マクロ_再帰(pintNo - 1, pintAn)

       p_intCAng = p_intCAng - pintAn

       GoSub ヒルベルト曲線描画マクロ_DRAW

       Call Sヒルベルト曲線描画マクロ_再帰(pintNo - 1, pintAn * -1)

       p_intCAng = p_intCAng + pintAn

    End If

    Exit Sub

    '========================================

ヒルベルト曲線描画マクロ_DRAW: '線描画処理（サブルーチン）

    '*角度より終点位置取得

    intPtX = p_intCptX: intPtY = p_intCptY

    Select Case Abs(p_intCAng Mod 360)

           Case 0:   intPtX = intPtX + cns_intLnLn

           Case 90: intPtY = intPtY + cns_intLnLn  _

                                  * Sgn(p_intCAng Mod 360) * -1

           Case 180: intPtX = intPtX - cns_intLnLn

           Case 270: intPtY = intPtY + cns_intLnLn  _

                                    * Sgn(p_intCAng Mod 360)

    End Select

    '*線描画

    With ActiveDocument.Shapes.AddLine( _

         p_intCptX, p_intCptY, intPtX, intPtY).Line

        .ForeColor.RGB = HLBTLCO          '←線色

        .Weight = HLBTLWEI                   '←線の太さ

    End With

    p_intCptX = intPtX: p_intCptY = intPtY

    Return

End Sub