三角形の内部を塗りつぶすのには？ (ID:75978)

名前

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

本文 仕事で使っていてタイムリーだったのでサンプルを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