求助高人 关于给闭合三角形填充颜色问题

[hngydx000]

我用如下代码在同一个picture空间给很多（5000以上）个三角形填充颜色，屏幕会卡住。三角形数量少的话就不会出现、怎么解决啊。

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
'创建区域
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor 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 POINTAPI
x As Long
y As Long
End Type
'点结构
Private Const WINDING = 2
'根据绘图方向填充图形


Private Sub Picture1_Paint()
Dim POI(2) As POINTAPI
POI(0).x = 0 '第一个点的横坐标（使用容器的坐标系）
POI(0).y = 0 '第一个点的纵坐标（使用容器的坐标系）

POI(1).x = 0 '第二个点的横坐标
POI(1).y = 200 '第二个点的纵坐标

POI(2).x = 200
POI(2).y = 200

Shapes = CreatePolygonRgn(POI(0), 3, WINDING)
'创建三角形区域，POI(0)是第一个点，3是点数
Brush = CreateSolidBrush(QBColor(3))
'创建一个黑色的刷子（RGB（0，0，0）代表黑色）
FillRgn Picture1.hdc, Shapes, Brush
'填充三角形,Me.hdc是窗体的图形设备句柄，shapes是区域句柄，Brush是刷子句柄
End Sub

[hngydx000]

谢谢大哥指导、我的问题是这样的
如下图所示的一个图形

把每个三角形进行涂色，当三角形数量为2000+时可以把每个三角形都涂色，然后显示的结果如下图：
http://hi.csdn.net/attachment/201203/12/5554075_1331533960l4RS.png
但当三角形数量为7000+时，就不会显示出来结果，只能显示出如下图所示的图形，然后屏幕就乱了。
http://hi.csdn.net/attachment/201203/12/5554075_1331533912g19F.png
这个问题怎么解决啊
[Quote=引用 1 楼 veron_04 的回复:]

填充例子
[/Quote]

[贝隆]

可否考虑在内存中绘图，填充，然后再通过bitblt复制到picturebox上来？速度肯定可以提高，但具体提高多少我就没有试验过了。

[of123]

5 楼说的是。

类似的情况：在连续用大数组内容填充当前窗体上的 TextBox 时，就最好不要直接对 TextBox 循环操作，而是在后台填好一个变量，将变量赋值给 TextBox 控件。

[hngydx000]

这种方法怎么实现呢，麻烦大哥能不能给一个例子啊。
[Quote=引用 5 楼 veron_04 的回复:]

可否考虑在内存中绘图，填充，然后再通过bitblt复制到picturebox上来？速度肯定可以提高，但具体提高多少我就没有试验过了。
[/Quote]

[贝隆]

可以给你一个绘图的例子，但不是绘制三角形并填充的，你可以看看：
http://download.csdn.net/detail/veron_04/2368159
这个方法比直接在PictureBOx上绘图快出很多。

[hngydx000]

非常感谢大哥提供的办法。用大哥的办法试了，可是还是不行。运行完的图像如下图：

还是不能把所有三角形填充完全。这种方法是不是有一个填充图形数量的限制啊。
运行完时候电脑屏幕也会花，

那些图标都显示不出来了。
画这种图还有什么别的办法么。
在内存绘图然后复制到picture的代码如下
Option Explicit
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
'创建区域


Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Private dc As Long
Private hBmp As Long
Private Type POINTAPI
x As Long
y As Long
End Type
'点结构
Private Const WINDING = 2



Private Sub Command1_Click()
Dim Shapes As Long
Dim Brush As Long
Dim POI(2) As POINTAPI
POI(0).x = 0 '第一个点的横坐标（使用容器的坐标系）
POI(0).y = 0 '第一个点的纵坐标（使用容器的坐标系）

POI(1).x = 0 '第二个点的横坐标
POI(1).y = 200 '第二个点的纵坐标

POI(2).x = 200
POI(2).y = 200

dc = CreateCompatibleDC(Picture1.hdc) '创建一个与窗体相兼容的设备场景

hBmp = CreateCompatibleBitmap(dc, Picture1.ScaleWidth / Screen.TwipsPerPixelX, Picture1.ScaleHeight / Screen.TwipsPerPixelY) '在内存中创建与窗体同样大小的位图

SelectObject hdc, hBmp '将位图选入刚才创建的设备场景中


Shapes = CreatePolygonRgn(POI(0), 3, WINDING)
'创建三角形区域，POI(0)是第一个点，3是点数
Brush = CreateSolidBrush(QBColor(3))
'创建一个黑色的刷子（RGB（0，0，0）代表黑色）
FillRgn Picture1.hdc, Shapes, Brush
'填充三角形,Me.hdc是窗体的图形设备句柄，shapes是区域句柄，Brush是刷子句柄

BitBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth / Screen.TwipsPerPixelX, Picture1.ScaleHeight / Screen.TwipsPerPixelY, dc, 0, 0, SRCCOPY '将内存位图中的图形拷贝到窗体上显示

DeleteObject Shapes '删除以前创建的对像用于释放内存
DeleteObject Brush
DeleteObject hBmp
DeleteDC dc

End Sub

[Quote=引用 5 楼 veron_04 的回复:]

可否考虑在内存中绘图，填充，然后再通过bitblt复制到picturebox上来？速度肯定可以提高，但具体提高多少我就没有试验过了。
[/Quote]

[Tiger_Zhao]

这是你2000+的图，明明大多数是方块，几乎没有三角。

所以你可以考虑一下简化绘图：
1)某些区域中聚集的三角直接合并成方块或大的三角。
2)即使在边界区域，某些很小的三角就不用填充了，最多直接画一个像素，更小的可以直接忽略的。
如果绘图区域不变，7000+ 的填充操作不会比 2000+ 多很多。

[赵4老师]

显示在屏幕上小于2×2像素的三角形有必要填充吗？

[hngydx000]

谢谢大哥的帮助。
那个图是根据下面这个图把三角形分类，每一类三角形填充一个颜色得到的。
这些三角形都是由有限元剖分程序剖分出来的网格文件绘制的，忽略了可能显示效果不会很好。

[Quote=引用 10 楼 tiger_zhao 的回复:]
这是你2000+的图，明明大多数是方块，几乎没有三角。

所以你可以考虑一下简化绘图：
1)某些区域中聚集的三角直接合并成方块或大的三角。
2)即使在边界区域，某些很小的三角就不用填充了，最多直接画一个像素，更小的可以直接忽略的。
如果绘图区域不变，7000+ 的填充操作不会比 2000+ 多很多。
[/Quote]

[hngydx000]

可是怎么判断那些三角形的像素足够小而不用填充啊[Quote=引用 11 楼 zhao4zhong1 的回复:]

显示在屏幕上小于2×2像素的三角形有必要填充吗？
[/Quote]

[dreamcs]

楼主可以使用OpenGl,几千三角形对于显卡来说小菜一碟。随便问一句，这有有限元网格划分么?

[hngydx000]

谢谢你，OpenG1是什么啊，我这个以后可能还会有上万网格。我的有限元网格是用一个叫trangle的程序得来的
[Quote=引用 14 楼 dreamcs 的回复:]

楼主可以使用OpenGl,几千三角形对于显卡来说小菜一碟。随便问一句，这有有限元网格划分么?
[/Quote]

[dreamcs]

楼主可以百度下OpenGL。可先试一下它。如果不行。楼主可使用四叉树等分层数据结构加速显示。

[dreamcs]

三角形的颜色是不是还要根据应力大小渐变么？

[Tiger_Zhao]

先定义一下这样一个距离 S 为任意两个点 (x1,y1) (x2,y2) 在 X,Y 轴投影的距离和
　S = Abs(x1-x2) + Abs(y1-y2)

一个三角的3个顶点可以算出3个 S
a)如果其中一个 S=0，两点重合，不用填充；
b)如果其中一个 S=1，两点相邻，不用填充；
c)如果其中一个 S=2 And (Abs(x1-x2)=1)，两点相邻，不用填充。

[hngydx000]

嗯，那样最好。可是我刚学，那个估计比较复杂，目前先不弄。只要每个三角形画一个颜色就行了
[Quote=引用 17 楼 dreamcs 的回复:]

三角形的颜色是不是还要根据应力大小渐变么？
[/Quote]

[贝隆]

这个使用OpenGL的确是不错的方法

[hngydx000]

非常感谢你啊。不过这种方法画出来的图很离散，效果不好，还是在想想别的办法。非常感谢你
[Quote=引用 18 楼 tiger_zhao 的回复:]

先定义一下这样一个距离 S 为任意两个点 (x1,y1) (x2,y2) 在 X,Y 轴投影的距离和
S = Abs(x1-x2) + Abs(y1-y2)

一个三角的3个顶点可以算出3个 S
a)如果其中一个 S=0，两点重合，不用填充；
b)如果其中一个 S=1，两点相邻，不用填充；
c)如果其中一个 S=2 And (Abs(x1-x2)=1)，两点相邻，不用填充。
[/Quote]

[hngydx000]

谢谢大哥。那我好好学学OpenGl吧
[Quote=引用 20 楼 veron_04 的回复:]

这个使用OpenGL的确是不错的方法
[/Quote]

[worldy]

Brush = CreateSolidBrush(QBColor(3))
GDI对象Brush没有删除吧