【Word VBA】水仙の花描画マクロ▽ソースコード
記事IT・テクノロジー
Option Explicit
Option Base 0
'
Public Sub 水仙の花描画マクロ()
Const NARCLEFT = 100 '描画開始位置Ｘ
Const NARCTOPP = 100 ' Ｙ
'
Const NARCCOLS = 4 '横/描画数
Const NARCROWS = 3 '縦/描画数
'
Const NARCVPIT = 70 '横/描画間隔
Const NARCHPIT = 60 '縦/描画間隔
'
Const NARCBZMG = 0.2 'ベジュ曲線描画倍率
Const NARCFRAD = (77.4 * NARCBZMG) '花びら
Const NARCGRAD = (90.1 * NARCBZMG) '筋
Const NARCMRAD = 11 '中側花びら半径
Const NARCORAD = 2 'おしべ描画半径
Const NARCARAD = 3
'
Const NARCLNWE = 1 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer, Lp As Integer
Dim sngBBas() As Single, sngBDat() As Single
Dim varBezi As Variant
Dim intCxp As Integer, intCyp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim intExp(1) As Integer, intEyp(1) As Integer
'
Dim lngCol(5) As Long, sngRad As Single
'
'ベジエ曲線データ
varBezi = Array(-3.61, -76.89, -7.94, -76.37, -13.44, -66.55, -18.21, _
-61.74, -22.99, -56.94, -28.2, -53.05, -32.27, -48.07, -36.33, -43.09, _
-39.92, -36.35, -42.61, -31.85, -45.3, -27.35, -50.43, -14.14, -51.17, _
-3.67, -51.91, 6.8, -50#, 20.95, -47.07, 30.96, -44.14, 40.98, -41.4, _
48.84, -33.58, 56.41, -25.75, 63.98, -10.49, 77.4, -0.12, 76.39, _
10.25, _
75.37, 23.5, 59.92, 30.86, 52.07, 38.22, 44.23, 40.62, 38.98, 44.04, _
29.31, 47.46, 19.65, 51.91, 4.92, 51.37, -5.92, 50.83, -16.77, 45.41, _
-28.2, 40.8, -35.77, 36.19, -43.34, 29.83, -46.74, 23.71, -51.36, _
17.58, -55.99, 12.34, -60.6, 7.79, -64.85, 3.23, -69.11, 0.72, _
-77.4, -3.61, -76.89)
'ベジエ曲線データ設定
ReDim sngBBas((UBound(varBezi, 1) - 1) \ 2, 1)
ReDim sngBDat((UBound(varBezi, 1) - 1) \ 2, 1)
For Kp = LBound(sngBBas, 1) To UBound(sngBBas, 1)
sngBBas(Kp, 0) = CSng(varBezi(Kp * 2 + 0)) * NARCBZMG
sngBBas(Kp, 1) = CSng(varBezi(Kp * 2 + 1)) * NARCBZMG
Next Kp
'
sngRad = (2 * Atn(1)) / 90
'
lngCol(0) = vbBlack '←線色
lngCol(1) = vbWhite '←塗りつぶし色
lngCol(2) = RGB(218, 165, 32) '〃
lngCol(3) = vbYellow '〃
lngCol(4) = RGB(255, 215, 0) '〃
lngCol(5) = RGB(169, 169, 169) '←筋の線色
For Jp = 0 To NARCROWS - 1
intCyp = (NARCTOPP + NARCFRAD) + NARCHPIT * Jp
For Ip = 0 To NARCCOLS - 1 - (Jp Mod 2)
intCxp = (NARCLEFT + NARCFRAD) + NARCVPIT * Ip _
+ (NARCVPIT \ 2) * (Jp Mod 2)
'
'*下側の花びら描画
For Lp = 0 To 2
'*花びら描画位置設定
intDxp = NARCFRAD * Cos(sngRad * (120 * Lp + 60)) + intCxp
intDyp = NARCFRAD * Sin(sngRad * (120 * Lp + 60)) + intCyp
For Kp = LBound(sngBDat, 1) To UBound(sngBDat, 1)
sngBDat(Kp, 0) = sngBBas(Kp, 0) + intDxp
sngBDat(Kp, 1) = sngBBas(Kp, 1) + intDyp
Next Kp
'*花びら描画
With ActiveDocument.Shapes.AddCurve(sngBDat)
.Fill.Visible = msoTrue
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol(0)
.Fill.ForeColor.RGB = lngCol(1)
.Line.Weight = NARCLNWE
.Rotation = (120 * Lp + 60) + 90
End With
intDxp = NARCGRAD * Cos(sngRad * (120 * Lp + 60)) + intCxp
intDyp = NARCGRAD * Sin(sngRad * (120 * Lp + 60)) + intCyp
'*花びらの筋描画
With ActiveDocument.Shapes.AddLine( _
intCxp, intCyp, intDxp, intDyp).Line
.ForeColor.RGB = lngCol(5)
.Weight = NARCLNWE
End With
Next Lp
'
'*上側の花びら描画
For Lp = 0 To 2
'*花びら描画位置設定
intDxp = NARCFRAD * Cos(sngRad * (120 * Lp + 0)) + intCxp
intDyp = NARCFRAD * Sin(sngRad * (120 * Lp + 0)) + intCyp
For Kp = LBound(sngBDat, 1) To UBound(sngBDat, 1)
sngBDat(Kp, 0) = sngBBas(Kp, 0) + intDxp
sngBDat(Kp, 1) = sngBBas(Kp, 1) + intDyp
Next Kp
'*花びら描画
With ActiveDocument.Shapes.AddCurve(sngBDat)
.Fill.Visible = msoTrue
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol(0)
.Fill.ForeColor.RGB = lngCol(1)
.Line.Weight = NARCLNWE
.Rotation = (120 * Lp + 0) + 90
End With
intDxp = NARCGRAD * Cos(sngRad * (120 * Lp + 0)) + intCxp
intDyp = NARCGRAD * Sin(sngRad * (120 * Lp + 0)) + intCyp
'*花びらの筋描画
With ActiveDocument.Shapes.AddLine( _
intCxp, intCyp, intDxp, intDyp).Line
.ForeColor.RGB = lngCol(5)
.Weight = NARCLNWE
End With
Next Lp
'*内側花びら輪っか描画
For Lp = 0 To 1
Kp = NARCMRAD - 2 * Lp
With ActiveDocument.Shapes.AddShape(msoShapeOval, _
intCxp - Kp, intCyp - Kp, Kp * 2, Kp * 2)
.Fill.Visible = msoTrue
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol(0)
.Fill.ForeColor.RGB = lngCol(2 + Lp)
End With
Next Lp
'*おしべ描画
For Lp = 0 To 2
intDxp = NARCARAD * Cos(sngRad * (120 * Lp + 30)) + intCxp
intDyp = NARCARAD * Sin(sngRad * (120 * Lp + 30)) + intCyp
With ActiveDocument.Shapes.AddShape(msoShapeOval, _
intDxp - NARCORAD, intDyp - NARCORAD, _
NARCORAD * 2, NARCORAD * 2)
.Fill.Visible = msoTrue
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol(0)
.Fill.ForeColor.RGB = lngCol(4)
End With
Next Lp
Next Ip
Next Jp
End Sub
蛇足
水仙は、作者の地元、福井県の県花である。
