三角形の内部を塗りつぶすのには？

---

VBのLINEメソッドで三角形を描きその内部を指定した色で塗りつぶしたいのですが。。。。。

編集 削除

---

APIのExtFloodFillを使うと出来ます。
LINEメソッドで三角を描画せず、APIのPolygonを使っても出来ます。

編集 削除

---

Windows98以降でなら、GradientFillというAPIもあるようです。
開始色と終了色をおなじにすれば、
ただの四角とおなじ。

  イラスト系の関数は、VBのだと遅い(アルゴリズムしだいかも)ので、
なるべくAPIにしたほうがよさそうです。
基本関数も少ないし。



  あとはちょっと横道。フォントの"▲"を使うのも、一つの手^^;

編集 削除

---

仕事で使っていてタイムリーだったのでサンプルを1つ。
APIを使って、多角形を塗りつぶすという関数です。
塗りつぶし(FillStyle)を設定し、FillColorの色で塗りつぶしてくれます。
座標は、X, Y, X, Y... と何個でも指定できます 

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Long, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function PaintRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const LOGPIXELSX = 88       '  Logical pixels/inch in X
Private Const LOGPIXELSY = 90       '  Logical pixels/inch in Y
Private Const ALTERNATE = 1         '交差したリージョンは塗らない
Private Const WINDING = 2           '交差したリージョンも塗る

Private Sub PaintRegion(Dest As Object, ParamArray P())
    ' PaintRegion
    '     多角形を塗りつぶす関数
    ' 使用方法:
    '     PaintRegion 描画オブジェクト, X1, Y1 , X2, Y2, ...
    '     描画オブジェクトには、Form, PictureBox, Printerなどが使用できます。
    '     座標はTwips単位で渡します
    '     塗りつぶし色は、描画オブジェクトのFillColorプロパティの値が使用されます。
    
    Dim Point() As Long                 '座標(ピクセルに変換した値)
    Dim hRgn As Long                    'リ−ジョンのハンドル
    Dim i As Long, nPoint As Long
    Dim PPTX As Single, PPTY As Single

    ReDim Point(0 To UBound(P))
    nPoint = (UBound(P) + 1) / 2
    
    PPTX = GetDeviceCaps(Dest.hdc, LOGPIXELSX) / 1440
    PPTY = GetDeviceCaps(Dest.hdc, LOGPIXELSY) / 1440
    For i = 0 To nPoint - 1
        'ピクセルに変換
        Point(i * 2) = CLng((P(i * 2) - Dest.ScaleLeft) * PPTX)
        Point(i * 2 + 1) = CLng((P(i * 2 + 1) - Dest.ScaleTop) * PPTY)
    Next i
    
    hRgn = CreatePolygonRgn(Point(0), nPoint, WINDING)
    PaintRgn Dest.hdc, hRgn
    DeleteObject hRgn
End Sub

Private Sub Command1_Click()
    'サンプル
    PaintRegion Picture1, 0, 0, 100, 2000, 300, 500, 500, 0
End Sub

編集 削除

---

Kenjiさんの補足として。
私はPictureboxをつかって、さらにボタンを作って。

Private Sub Command1_Click()
    Form1.Picture1.Line (0, 10)-(800, 10), &HFF0000
    Form1.Picture1.Line (0, 10)-(400, 500), &HFF0000
    Form1.Picture1.Line (400, 500)-(800, 10), &HFF0000
    'サンプル
    PaintRegion Picture1, 0, 10, 400, 500, 800, 10
End Sub

hRgn = CreatePolygonRgn(Point(0), nPoint, WINDING)
文の上に
    Form1.Picture1.FillColor = RGB(255, 0, 0)
    '塗りつぶし
    Form1.Picture1.FillStyle = vbFSSolid
を２行追加して、テスト完です。

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。