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

直線による作図　−　カレイドスコープ

乱数で設定した色で直線を描きます。

実行する度にパターンが変化します。

Sub Kaleidoscope()

  Dim i, c, dx

  monhdc = GetForegroundWindow()
  myhdc = GetDC(monhdc)
  If myhdc = 0 Then Exit Sub

  InitializeGraphics

  Randomize (Val(Right$(Time$, 2)))
  dx = Int(Rnd(1) * 10)

  For i = 0 To 199 Step dx + 2
     c = QBColor(Int(Rnd(1) * 16))
     Call DrawLine(i, 0, 199 - i, 199, c)
     Call DrawLine(399 - i, 0, 200 + i, 199, c)
     Call DrawLine(i, 399, 199 - i, 200, c)
     Call DrawLine(399 - i, 399, 200 + i, 200, c)
  Next i

  dx = dx \ 2
  For i = 0 To 199 Step dx + 2
     c = QBColor(Int(Rnd(1) * 16))
     Call DrawLine(0, 199 - i, 199, i, c)
     Call DrawLine(200, i, 399, 199 - i, c)
     Call DrawLine(0, 200 + i, 199, 399 - i, c)
     Call DrawLine(399, 200 + i, 200, 399 - i, c)
  Next i

End Sub

kaleidoscope

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