如何在picturebox中画一个三角形并在三角形内填充上颜色？

Question

如何在picturebox中画一个三角形并在三角形内填充上颜色？

Answer 1

先用picturebox的line方法画线，再有API函数FillRgn(记不清了，不过差不多)填充就可以了。

Answer 2

Option Explicit
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As polyPI, ByVal nCount As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As LongPrivate Type polyPI
 x As Long
 y As Long
End TypePrivate Const ALTERNATE = 1 ' ALTERNATE and WINDING are
Private Const WINDING = 2 ' constants for FillMode.
Private Const BLACKBRUSH = 4Private Sub Command1_Click()
Dim poly(1 To 3) As polyPI
Dim num As Integer
Dim hBrush, hRgn As Long
num = 3
     poly(1).x = Form1.ScaleWidth / 2
     poly(1).y = Form1.ScaleHeight / 2
     poly(2).x = Form1.ScaleWidth / 4
     poly(2).y = 3 * Form1.ScaleHeight / 4
     poly(3).x = 3 * Form1.ScaleWidth / 4
     poly(3).y = 3 * Form1.ScaleHeight / 4
Call Polygon(Picture1.hdc, poly(1), num)
 hBrush = GetStockObject(BLACKBRUSH)
 hRgn = CreatePolygonRgn(poly(1), num, ALTERNATE) ' 通过创建成功就使用颜色填充
 If hRgn Then Call FillRgn(Picture1.hdc, hRgn, hBrush)
 Call DeleteObject(hRgn)
End Sub

Answer 3

MmMVP(杜霖:main(){MmMVP!=MsMVP;while(1) {kiss MM;}}) ：
    我试了试你的方法，没有出现结果。麻烦你再试以下。非常感谢。
rainbow8966(波波) ：
    我给你发了一封邮件，把你的程序给我传过来吧，谢谢。

Answer 4

LPan008() :
我把你说的方法和MmMVP(杜霖:main(){MmMVP!=MsMVP;while(1) {kiss MM;}}) 说的结合起来，三角形画出来了，但是填充的效果没有出现。

Answer 5

记住3个点的坐标，利用API函数CreatePolygonRgn根据坐标建立
三角形区域，使用API函数FillRgn填充这个区域 :Private Type POINTAPI
        X As Long
        Y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePrivate Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, _
        ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, _
        ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, _
        ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) _
        As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal _
        hObject As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As LongConst ALTERNATE = 1
Const WINDING = 2Dim hRgn As LongPrivate Sub Command1_Click()
    Dim xx(4) As POINTAPI
    Dim lB As Long
    Dim lOld As Long
    
    xx(0).X = 0: xx(0).Y = 0
    xx(1).X = 50: xx(1).Y = 0
    xx(2).X = 50: xx(2).Y = 50
    xx(3).X = 0: xx(3).Y = 50
    xx(4).X = 5: xx(4).Y = 25
    
    '建立不规则区域
    hRgn = CreatePolygonRgn(xx(0), 5, ALTERNATE)
    If hRgn <> 0 Then
        lB = CreateSolidBrush(RGB(255, 0, 0))
        '填充不规则区域
        Debug.Print FillRgn(Picture1.hdc, hRgn, lB)
    End If
End Sub

Answer 6

不用填充的，直接用Polygon函数画三角形就可以了，会自动用当前Brush填充~

Answer 7

'以下例子用Polygon函数画一个三角形
'并同时用当前Brush填充(创建新Brush并选进DC，用完后恢复原Brush)
'其中点的坐标请根据实际情况自己赋值
'要注意API函数中的坐标为象素
Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Type POINTAPI
    x As Long
    y As Long
End Type    Dim hPen As Long
    Dim hPenOld As Long
    Dim hBrush As Long
    Dim hBrushOld As LongDim pt(9) As POINTAPI
            pt(0).x = 
            pt(0).y = 
            pt(1).x = 
            pt(1).y = 
            pt(2).x = 
            pt(2).y =             hPen = CreatePen(0, 1, 边_color)
            hPenOld = SelectObject(Picture1.hdc, hPen)
            hBrush = CreateSolidBrush(填充_color)
            hBrushOld = SelectObject(Picture1.hdc, hBrush)
            Polygon Picture1.hdc, pt(0), 10
            
            SelectObject Picture1.hdc, hPenOld
            SelectObject Picture1.hdc, hBrushOld
            DeleteObject hPen
            DeleteObject hBrush

Answer 8

MmMVP(杜霖:main(){MmMVP!=MsMVP;while(1) {kiss MM;}}) ：
你的方法可以，我把坐标设置的太大了。谢谢各位。结帖。