PowerPoint VBA GDI32命令による
ワールド座標グラフィックス描画命令ライブラリの利用例

基本的なグラフィックス描画機能　−　矩形、楕円、線種

例１ 　−　色を変えて箱を描く

Sub ColorBox()
Dim c, myBoxSize, myInterval
Dim x1, y1, x2, y2 

  monhdc = GetForegroundWindow()
  myhdc = GetDC(monhdc)
  If myhdc = 0 Then Exit Sub
  
  InitializeGraphics   ' グラフィックス利用の開始宣言

  myBoxSize = 24
  myInterval = myBoxSize + 6
  x1 = 10
  y1 = 10
  For c = 0 To 14
     DrawRectangle x1, y1, x1 + myBoxSize, y1 + myBoxSize, QBColor(c)   ' 箱を描く
     x1 = x1 + myInterval
  Next c
  x1 = 10
  y1 = 60
  For c = 0 To 14
     DrawRectangleFill x1, y1, x1 + myBoxSize, y1 + myBoxSize, QBColor(c)   ' 塗りつぶした箱を描く
     x1 = x1 + myInterval
  Next c
  x1 = 10
  y1 = 100
  For c = 0 To 14
   ' 塗りと線の色が異なる箱を描く
     DrawRectangleFill x1, y1, x1 + myBoxSize, y1 + myBoxSize, QBColor(c), QBColor(c + 1)
     x1 = x1 + myInterval
  Next c
  
 End Sub

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

例２ 　−　色を変えて円を描く

Sub ColorCircle()
  Dim c, r, d
  Dim x, y

  monhdc = GetForegroundWindow()
  myhdc = GetDC(monhdc)
  If myhdc = 0 Then Exit Sub
  
  r = 20
  d = 50

  InitializeGraphics   ' グラフィックス利用の開始宣言

  gClear   ' 画面消去

  c = 0   ' 色番号の初期化
  For y = 30 To 100 Step d
    For x = 40 To 400 Step d
      DrawOval x, y, r, r, QBColor(c)   ' 円を描く
      c = c + 1
    Next x
  Next y
  
  c = 0
  For y = 140 To 210 Step d
    For x = 40 To 400 Step d
      DrawOvalFill x, y, r, r, QBColor(c)   ' 塗りつぶした円を描く
      c = c + 1
    Next x
  Next y
End Sub

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

例３ 　−　楕円を描く

Sub DrawOvalTest()

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

  InitializeGraphics   ' グラフィックス利用の開始宣言
  ' 楕円を描く
  DrawOval 100, 80, 70, 30, vbGreen
  ' 正円を描く
  DrawOval 200, 80, 30, 30, vbBlack
  ' デフォールトによる半径比率と色指定
  DrawOval 260, 80, 50
  ' 塗と線の色のQBColor関数による指定
  DrawOvalFill 360, 80, 40, , QBColor(9), QBColor(12)
  
End Sub

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

例４ 　−　線の太さと種類を変える

Sub LineStyleTest（）

  Dim c, y
  Const x1 = 30
  Const x2 = 330
  Const d = 20

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

  InitializeGraphics   ' グラフィックス利用の開始宣言

  c = QBColor(0)
  y = 30

  gLineWidth = 3   ' 線の太さ
  DrawLine x1, y, x2, y, c   ' 線を描く
  
  y = y + d
  gLineWidth = 10   ' 線の太さ
  DrawLine x1, y, x2, y, c   ' 線を描く
  
  y = y + d
  gLineWidth = 1   ' 線の太さ
  DrawLine x1, y, x2, y, c
  
 y = y + d
  SetLineStyle PS_DASH
  DrawLine x1, y, x2, y, c
  
  y = y + d
  SetLineStyle PS_DOT
  DrawLine x1, y, x2, y, c
  
  y = y + d
  SetLineStyle PS_DASHDOT
  DrawLine x1, y, x2, y, c
  
  y = y + d
  SetLineStyle PS_DASHDOTDOT
  DrawLine x1, y, x2, y, c
  
End Sub

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

戻る

このページの著作権は，木原　寛が保有しています。