如何做一个三角形或其他形状的shape?

[cokeliu]

VB6中的shape只有圆形和四方型等. 如何做一个三角形或其他形状的shape. 怎么做的?

[fj182]

用API来画

[northwolves]

CreatePolyPolygonRgn

VB声明
Declare Function CreatePolyPolygonRgn Lib "gdi32" Alias "CreatePolyPolygonRgn" (lpPoint As POINTAPI, lpPolyCounts As Long, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long

说明
创建由多个多边形构成的区域。每个多边形都应是封闭的

返回值
Long，执行成功则为创建区域的句柄，失败则为零

参数表
参数 类型及说明
lpPoint POINTAPI，nCount个POINTAPI结构中的第一个POINTAPI结构
lpPolyCounts Long，长整数阵列的第一个入口。每个入口包含构成一个封闭多边形的点数。lpPoint阵列组成了一系列多边形，每个多边形在lpPolyCounts中有一个入口

nCount Long，多边形的点数

nPolyFillMode Long，描述多边形填充模式。可为ALTERNATE 或 WINDING常数。

填充模式1——ALTERNATE：为判断一个点是否位于填充区，windows会从这个点到图形外部画一条假想的线。每与一条线相交，计数器就会增1。如最后一个记数是奇数，则填充这个点；如果是偶数，则保留原样不变
填充模式2——WINDING：为判断一个点是否位于填充区，windows会从这个点到图形外部画一条假想的线。windows会跟踪画出每个顶点（线段）的方向。这条假想的线每次穿过一个顶点时，而且顶点的Y方向为正，则减一个记数。如结果记数不是零，就表明该点位于填充区域

注解
不用时一定要用DeleteObject函数删除该区域

[chelator]

能不能举一个示例，例如画三角形，填充它。

[balloonman2002]

１．创建多边形可以参考：
http://blog.csdn.net/balloonman2002/archive/2004/06/28/28697.aspx
中搜索＂CreatePolygonRgn＂

２．填充多边形可以用fillrect函数，参考：
http://blog.csdn.net/balloonman2002/archive/2004/06/25/26825.aspx
中搜索＂fillrect＂

３．给多边形绘边可以用framerect函数；

[chelator]

帮忙看一下，为什么不能画出三角形

Private Type POINTAPI
X As Single
Y As Single

End Type

Private Declare Function CreatePolygonRgn Lib "gdi32.dll" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long


Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Dim Shapev(3) As POINTAPI
Private Sub Command1_Click()
Dim tri As Long, tri1 As Long
Dim color As Long
Shapev(1).X = 2000
Shapev(1).Y = 2000
Shapev(2).X = 2000 - 50
Shapev(2).Y = 2000 - 30
Shapev(3).X = 2000 + 50
Shapev(3).Y = 2000 - 30

color = &HFF
tri = CreatePolygonRgn(Shapev(1), 3, 1)
tri1 = FrameRgn(Form1.hdc, rgo, color, 1, 1)
Call DeleteObject(rgo)
Call DeleteObject(myrgo)
End Sub

[zou19820704]

Option Explicit
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor 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 Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type

Private Sub Command1_Click()
Dim hPen As Long
Dim hPenOld As Long
Dim hBrush As Long
Dim hBrushOld As Long

Dim pt(2) As POINTAPI
pt(0).x = 20
pt(0).y = 20
pt(1).x = 40
pt(1).y = 30
pt(2).x = 20
pt(2).y = 40




Dim B_color As Long, T_color As Long
B_color = QBColor(15)
T_color = vbRed

hPen = CreatePen(0, 1, B_color)
hPenOld = SelectObject(Picture1.hdc, hPen)
hBrush = CreateSolidBrush(T_color)
hBrushOld = SelectObject(Picture1.hdc, hBrush)
Polygon Picture1.hdc, pt(0), 3

SelectObject Picture1.hdc, hPenOld
SelectObject Picture1.hdc, hBrushOld
DeleteObject hPen
DeleteObject hBrush
End Sub

[zou19820704]

上面的我调试过，没有问题！

[zou19820704]

上面的我调试过，没有问题！

[chelator]

确认

[chelator]

谢谢

[chelator]

问题解决了