不看会后悔的Windows XP之经验谈	简单快捷DIY实用家庭影院

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

楼主qinguangjun123（..net）2005-05-11 15:58:24 在 VB / 基础类提问

如何在picturebox中画一个三角形并在三角形内填充上颜色？问题点数：60、回复次数：10Top

1 楼qinguangjun123（..net）回复于 2005-05-11 16:14:25 得分 0

自己顶。Top

2 楼LPan008（）回复于 2005-05-11 16:15:05 得分 5

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

3 楼MmMVP（杜霖:（现在是DooDu的马甲。。））回复于 2005-05-11 16:20:00 得分 15

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 Long

Private Type polyPI
x As Long
y As Long
End Type

Private Const ALTERNATE = 1 ' ALTERNATE and WINDING are
Private Const WINDING = 2 ' constants for FillMode.
Private Const BLACKBRUSH = 4

Private 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 SubTop

4 楼rainbow8966（波波）回复于 2005-05-11 17:32:05 得分 15

我有一个跟这相关的例子，你可以参考一下
我的邮箱：rainbo@126.comTop

5 楼qinguangjun123（..net）回复于 2005-05-12 09:16:42 得分 0

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

6 楼qinguangjun123（..net）回复于 2005-05-12 09:23:59 得分 0

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

7 楼TechnoFantasy（（VB MVP）www.applevb.com）回复于 2005-05-12 09:34:27 得分 10

记住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 Type

Private 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 Long

Const ALTERNATE = 1
Const WINDING = 2

Dim hRgn As Long

Private 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
Top

8 楼viena（维也纳N02）回复于 2005-05-12 09:40:24 得分 15

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

9 楼viena（维也纳N02）回复于 2005-05-12 09:42:28 得分 0

'以下例子用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 Long

Private 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 Long

Dim 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 hBrushTop

10 楼qinguangjun123（..net）回复于 2005-05-12 10:05:59 得分 0

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