円を点描する(VB)

説明:

まず、円形のパスを作成する。次にFlattenPathにより円を線分に分割し、それぞれの線分の座標をGetPathによって取得する。最後に、それぞれの線分の座標の情報を元に点描を行う。

(本サンプルはNTでのみ動作可能。95/98の場合、描画関数を変更すること。)

キーワード:

BeginPath, Ellipse, EndPath, FlattenPath, GetPath

サンプルコード:

Private Sub Command1_Click()
    
    Const PI As Single = 3.14159
    
    Dim I As Long
    Dim J As Long
    Dim Deep As Long
    Dim PointNum As Long
    Dim Points(10000) As POINT
    Dim Types(10000) As Byte
    Dim X As Long
    Dim Y As Long
    Dim A As Single
    Dim B As Single
    Dim R As Single
     
    Picture1.ScaleMode = vbPixels
    
    'パス作成
    BeginPath Picture1.hDC
    Ellipse Picture1.hDC, 5, 5, 150, 150
    EndPath Picture1.hDC

    ' 線分の集合に変換し、座標を取得
    FlattenPath Picture1.hDC
    PointNum = GetPath(Picture1.hDC, Points(0), Types(0), 10000)
    
    '注:このサンプルの場合、最初がPT_MOVETO、最後がPT_CLOSEFIGURE Or PT_LINETO、それ以外がPT_LINETOとなる
    
    If PointNum = 0 Then
        MsgBox "err: " & Err.LastDllError
        Exit Sub
    End If

    '点描
    For I = 0 To PointNum - 2
        Deep = (Sqr((Points(I).X - Points(I + 1).X) ^ 2 + (Points(I).Y - Points(I + 1).Y) ^ 2) + 1) * 3
        For J = 1 To Deep
            A = Rnd
            B = Rnd * PI * 2
            R = Rnd * 10
            X = Points(I).X * A + Points(I + 1).X * (1 - A) + R * Cos(B)
            Y = Points(I).Y * A + Points(I + 1).Y * (1 - A) + R * Sin(B)
            Picture1.PSet (X, Y)
        Next
    Next
    
End Sub




(original text:1999/10/21 更新)

本ドキュメントの内容は保証しません。本ドキュメントによって生じた結果について、一切の責任を負いません。