Word VBAによるグラフィックス描画の例

プログラム  − リサージュ図形を描く

パラメータの値は適当に変更してください。

Sub Draw_Lissajous()

  Dim d, de, alpha, beta, c
  Dim w1, w2, a, b
  Const Pi = 3.1415926535898
  
  monhdc = GetForegroundWindow()
  myhdc = GetDC(monhdc)
  If myhdc = 0 Then Exit Sub
  
  Randomize (Val(Right$(Time$, 2)))
  c = Int(Rnd(1) * 16)

  InitializeGraphics
  SetViewPort 10, 10, 410, 410
  SetGraphicsWindow -30, -20, 30, 20
  gLineWidth = 2

  a = 30
  b = -20
  alpha = 0
  beta = 0
  d = Pi / 180
  de = 3 * Pi + d

  w1 = 4
  w2 = 5

  Lissajous a, b, d, de, w1, w2, alpha, beta, c

End Sub

Sub Lissajous(a, b, d, de, w1, w2, alpha, beta, c)

Dim T, x1, y1, x2, y2

DrawAxis2 a, b

x1 = a * Sin(alpha)
y1 = b * Sin(beta)

For T = d To de Step d
    x2 = a * Sin(w1 * T + alpha)
    y2 = b * Sin(w2 * T + beta)
    DrawLine x1, y1, x2, y2, QBColor(c)
    x1 = x2
    y1 = y2
Next T

End Sub

Sub DrawAxis2(a, b)

  DrawLine -a, 0, a, 0
  DrawLine 0, b, 0, -b

End Sub

ソース・プログラムのダウンロード