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

各格子点の電子密度の値に応じて色の階調をRGBそれぞれ256段階で変えて点を表示します。

AddShape命令によるライブラリを利用した場合に比べて非常に高速に描かれます。 格子点の数を増やしても（DIM_X，DIM_Yの値を大きくする）問題ありません。

1. Module2にGDI32命令によるグラフィックス描画命令ライブラリを貼り付けます。
2. ユーザーフォームを挿入します。ユーザーフォームのサイズをViewportと同じかそれより大きく設定してください。
3. スライドにボタンを挿入し、ダブルクリックしてFormを表示するためのプロシージャを記入します。

Private Sub CommandButton1_Click()
  UserForm1.Show
End Sub

4. Formにボタンを挿入します。
5. ボタンをダブルクリックして、原子軌道を計算し表示するプロシージャに対するCALL命令を記入します。

Private Sub CommandButton1_Click()
    DrawAOMap
End Sub

6. フォームモジュールまたはModule1などに、デバイスコンテキストの取得と原子軌道を計算し表示するプロシージャを記入します。

Sub Draw_AOMap()
' デバイスコンテキストの取得
    monhdc = GetForegroundWindow()
    myhdc = GetDC(monhdc)
    If myhdc = 0 Then Exit Sub

' Draw contour map of atomic orbitals    by H. Kihara
' 3dxy radial distribution function
' const 0.00985 = sqrt(2)/(81*sqrt(pi))

Const DIM_X = 300
Const DIM_Y = 300
Const MAX_GRAD = 255
Const ELD = 0.000001          ' threshold

Dim CR As Integer, CG As Integer, CB As Integer
Dim r As Single, dx As Single
Dim x As Single, y As Single, px As Single, py As Single
Dim phi As Single, rho As Single
Dim i As Integer, j As Integer

    InitializeGraphics
    
    r = 15     ' 計算範囲（ボーア単位）

    dx = r * 2 / DIM_X    ' 刻み幅
    y = -r

    For i = 1 To DIM_Y
        y = y + dx
        x = -r
        
        For j = 1 To DIM_X
            x = x + dx
            r = Sqr(y * y + x * x)
            phi = 0.00985 * Exp(-r / 3) * x * y
            rho = phi * phi
            CG = rho / ELD
            If CG > MAX_GRAD Then CG = MAX_GRAD
            If phi < 0 Then CR = 0 Else CR = CG
'  ====  ピクセル単位 のライブラリを使用する場合  =======
'   ピクセル単位の座標をポイント単位に変換　　×72÷96
            px = i / Pt2Px: py = j / Pt2Px
            PointSet px, py, RGB(CR, CG, CB)
'  ====  ポイント単位 のライブラリを使用する場合  =======
'            PointSet i, j, RGB(CR, CG, CB)
       Next j
    Next i
    
End Sub

1. Wordファイルを開きます。自動的にFormが表示されます。
2. 原子軌道を計算し表示するプロシージャをCALLするボタンをクリックします。