● 多角形を描画する ●

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

Private Const Convert As Double = 3.14159265 / 180

'-----------------------------------------------------------------------
' 関数名 : DrawPolygon
' 機能   : 多角形を描画する
' 引数   : (in) hDC … デバイスコンテキストのハンドル
'           (in) ApexNum … 頂点の数
'           (in) Radius  … 半径
'           (in) cXPos   … 中心のX座標
'           (in) cYPos   … 中心のY座標
' 戻り値 : 1…正常終了   0…異常終了
'-----------------------------------------------------------------------
Public Function DrawPolygon(ByVal hDC As Long, _
                            ByVal ApexNum As Long, _
                            ByVal Radius As Long, _
                            ByVal C_XPos As Long, _
                            ByVal C_YPos As Long) As Long

    Dim udtPA() As POINTAPI
    Dim Angle As Long '固定角度の変数
    Dim i As Long

    '具体的な配列数を指定して再び"udtPA" の変数の宣言をする
    ReDim udtPA(ApexNum - 1) As POINTAPI

    For i = 0 To ApexNum - 1
        Angle = CLng(360 / ApexNum) * (i + 1)

        '各頂点の座標を設定する
        udtPA(i).x = C_XPos + CLng(Fix(Cos((90 - Angle) * Convert) * Radius))
        udtPA(i).y = C_YPos - CLng(Fix(Sin((90 - Angle) * Convert) * Radius))
    Next i

    DrawPolygon = Polygon(hDC, udtPA(0), ApexNum)

End Function

あとは Form1 にテキストボックス・コマンドボタン・ピクチャーボックスを配置して、以下のコードを書く。

Private Sub Command1_Click()

    Dim ApexNum As Long

    '頂点の数を取得
    If Text1.Text = "" Then Text1.Text = "3"
    ApexNum = CLng(Text1.Text)
    If ApexNum > 90 Or ApexNum < 3 Then
        Call MsgBox("3〜90までの数字を入力してください。", vbOKOnly + vbExclamation, _
                  "数字の入力ミス")
        Exit Sub
    End If

    With Picture1
        .Cls
        .DrawWidth = 3              '線の太さを3に設定
        .FillStyle = 0              '塗りつぶしモード
        .FillColor = vbBlue         '塗りつぶし色設定
        .ForeColor = RGB(0, 0, 128) '線の色

        '多角形描画
        Call DrawPolygon(Picture1.hDC, ApexNum, 45, 75, 55)

        .CurrentX = 5
        .CurrentY = 5
        .ForeColor = vbRed
        Picture1.Print ApexNum & "角形"

        .Refresh
    End With

End Sub

Private Sub Form_Load()
    '一応フォームとピクチャーボックスだけ各々の設定をする
    'ほんとは全部やらねばならないのだがここでは省略
    'フォームのサイズを 260×160にする

    With Me
        .ScaleMode = vbPixels
        .Width = 260 * Screen.TwipsPerPixelX
        .Height = 160 * Screen.TwipsPerPixelY + .Height - _
                   .ScaleHeight * Screen.TwipsPerPixelY
    End With

    With Picture1
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .Width = 150
        .Height = 110
    End With

    Text1.Text = "3"

End Sub

戻る