在VB中如何实现“画图”程序中快速填充多边形颜色

时间:2022-07-18 09:03:43
如题,请快,谢谢
注:画图程序就是WINDOWS自带的附件中的画图程序。

9 个解决方案

#1


其实Windows的gdi32.dll有这样的函数
只是VB没有封装成对应方法


FloodFill 

VB声明 
Declare Function FloodFill Lib "gdi32" Alias "FloodFill" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long 
说明 
用当前选定的刷子在指定的设备场景中填充一个区域。区域是由颜色crColor定义的 
返回值 
Long,非零表示成功,零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
hdc Long,设备场景的句柄 
x,y Long,开始填充的那个点,用逻辑坐标表示 
crColor Long,欲使用的边界颜色。由这个颜色包围的表面会被填充 
注解 
点x,y绝对不能有颜色crColor,而且必须在剪切区域内。这个函数只对光栅设备有效,请参考ExtFloodFill的注解
 











ExtFloodFill 

VB声明 
Declare Function ExtFloodFill Lib "gdi32" Alias "ExtFloodFill" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long 
说明 
在指定的设备场景里,用当前选择的刷子填充一个区域 
返回值 
Long,非零表示成功,零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
hdc Long,设备场景的句柄 
x,y Long,开始填充的一个点,采用逻辑坐标表示 
crColor Long,要使用的边界颜色 
wFillType Long,欲执行的填充类型,由下述任何一个常数决定 
FLOODFILLBORDER 等同于FloodFill函数的功能 
FLOODFILLSURFACE 从指定的点向外填充,只到找到了crColor颜色(在边框采用了多种颜色时使用) 
注解 
如指定了FLOODFILLBORDER,那么x,y点绝对不能为crColor颜色。如指定了FLOODFILLSURFACE,那么x,y点必须是crColor颜色。这个函数只能在光栅设备中使用。可用GetDeviceCaps函数判断设备是否支持这个函数
 
提示 
一旦指定了FLOODFILLBORDER,务必保证初始点的颜色没有crColor。如果使用的是FLOODFILLSURFACE,务必保证初始点有颜色crColor(这是函数执行失败最常见的两个原因)。注意保证初始点位于剪切区内 













Polygon 

VB声明 
Declare Function Polygon Lib "gdi32" Alias "Polygon" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long 
说明 
描绘一个多边形,由两点或三点的任意系列构成。windows会将最后一个点与第一个点连接起来,从而封闭多边形。多边形的边框用当前选定的画笔描绘,多边形用当前选定的刷子填充 
返回值 
Long,非零表示成功,零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
hdc Long,用于描绘的设备场景 
lpPoint POINTAPI,在nCount POINTAPI结构数组中的第一个POINTAPI结构 
nCount Long,多边形的总点数(顶点数) 
注解 
GetPolyFillMode 和 SetPolyFillMode 函数决定了如何在多边形内部填充
 

#2


'以下例子用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 = 
            pt(3).x = 
            pt(3).y = 
            pt(4).x = 
            pt(4).y = 
            pt(5).x = 
            pt(5).y = 
            pt(6).x = 
            pt(6).y = 
            pt(7).x = 
            pt(7).y = 
            pt(8).x = 
            pt(8).y = 
            pt(9).x = 
            pt(9).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

#3


up

#4


其中Picture1是一个PictureBox控件,
边_color、填充_color是表示颜色的Long型数,也用RGB(red,green,blue)函数生成,其中red,green,blue为0-255的数

#5


mark

#6


up

#7


楼上各位都没实现搂主想要的功能
所以,你们都有抢分的嫌疑

#8


晕,楼上啥意思?

#9


不同意"sakurako(DearDream"的说法,其实"zyl910(910:分儿,我又来了!) "说的就已经是答案了,本来不想再回这贴了,因为已有答案了。但看了sakurako(DearDream的贴后还是回下吧,这回我给个简单的例子,虽然例子中使用的是矩形,但实际上可以填充任意形状的“封闭”区域

Option Explicit

Const PS_DOT = 2
Const PS_SOLID = 0

Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Sub Form_Load()
    Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
    Dim hHBr As Long, hFRgn As Long, hRRgn As Long, hRPen As Long
    Dim hFFBrush As Long, mIcon As Long, Cnt As Long

    Me.Cls
   
    '画个蓝色矩形边框
    hRPen = CreatePen(PS_SOLID, 2, vbBlue)
    DeleteObject SelectObject(Me.hdc, hRPen)
    Rectangle Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25
    DeleteObject hRPen

    ' 用黄色填充这个蓝色矩形
    hFFBrush = CreateSolidBrush(vbYellow)
    SelectObject Me.hdc, hFFBrush
    FloodFill Me.hdc, Me.ScaleWidth / 2, Me.ScaleHeight / 2, vbBlue
    DeleteObject hFFBrush
End Sub
Private Sub Form_Resize()
    Form_Paint
End Sub


#1


其实Windows的gdi32.dll有这样的函数
只是VB没有封装成对应方法


FloodFill 

VB声明 
Declare Function FloodFill Lib "gdi32" Alias "FloodFill" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long 
说明 
用当前选定的刷子在指定的设备场景中填充一个区域。区域是由颜色crColor定义的 
返回值 
Long,非零表示成功,零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
hdc Long,设备场景的句柄 
x,y Long,开始填充的那个点,用逻辑坐标表示 
crColor Long,欲使用的边界颜色。由这个颜色包围的表面会被填充 
注解 
点x,y绝对不能有颜色crColor,而且必须在剪切区域内。这个函数只对光栅设备有效,请参考ExtFloodFill的注解
 











ExtFloodFill 

VB声明 
Declare Function ExtFloodFill Lib "gdi32" Alias "ExtFloodFill" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long 
说明 
在指定的设备场景里,用当前选择的刷子填充一个区域 
返回值 
Long,非零表示成功,零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
hdc Long,设备场景的句柄 
x,y Long,开始填充的一个点,采用逻辑坐标表示 
crColor Long,要使用的边界颜色 
wFillType Long,欲执行的填充类型,由下述任何一个常数决定 
FLOODFILLBORDER 等同于FloodFill函数的功能 
FLOODFILLSURFACE 从指定的点向外填充,只到找到了crColor颜色(在边框采用了多种颜色时使用) 
注解 
如指定了FLOODFILLBORDER,那么x,y点绝对不能为crColor颜色。如指定了FLOODFILLSURFACE,那么x,y点必须是crColor颜色。这个函数只能在光栅设备中使用。可用GetDeviceCaps函数判断设备是否支持这个函数
 
提示 
一旦指定了FLOODFILLBORDER,务必保证初始点的颜色没有crColor。如果使用的是FLOODFILLSURFACE,务必保证初始点有颜色crColor(这是函数执行失败最常见的两个原因)。注意保证初始点位于剪切区内 













Polygon 

VB声明 
Declare Function Polygon Lib "gdi32" Alias "Polygon" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long 
说明 
描绘一个多边形,由两点或三点的任意系列构成。windows会将最后一个点与第一个点连接起来,从而封闭多边形。多边形的边框用当前选定的画笔描绘,多边形用当前选定的刷子填充 
返回值 
Long,非零表示成功,零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
hdc Long,用于描绘的设备场景 
lpPoint POINTAPI,在nCount POINTAPI结构数组中的第一个POINTAPI结构 
nCount Long,多边形的总点数(顶点数) 
注解 
GetPolyFillMode 和 SetPolyFillMode 函数决定了如何在多边形内部填充
 

#2


'以下例子用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 = 
            pt(3).x = 
            pt(3).y = 
            pt(4).x = 
            pt(4).y = 
            pt(5).x = 
            pt(5).y = 
            pt(6).x = 
            pt(6).y = 
            pt(7).x = 
            pt(7).y = 
            pt(8).x = 
            pt(8).y = 
            pt(9).x = 
            pt(9).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

#3


up

#4


其中Picture1是一个PictureBox控件,
边_color、填充_color是表示颜色的Long型数,也用RGB(red,green,blue)函数生成,其中red,green,blue为0-255的数

#5


mark

#6


up

#7


楼上各位都没实现搂主想要的功能
所以,你们都有抢分的嫌疑

#8


晕,楼上啥意思?

#9


不同意"sakurako(DearDream"的说法,其实"zyl910(910:分儿,我又来了!) "说的就已经是答案了,本来不想再回这贴了,因为已有答案了。但看了sakurako(DearDream的贴后还是回下吧,这回我给个简单的例子,虽然例子中使用的是矩形,但实际上可以填充任意形状的“封闭”区域

Option Explicit

Const PS_DOT = 2
Const PS_SOLID = 0

Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Sub Form_Load()
    Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
    Dim hHBr As Long, hFRgn As Long, hRRgn As Long, hRPen As Long
    Dim hFFBrush As Long, mIcon As Long, Cnt As Long

    Me.Cls
   
    '画个蓝色矩形边框
    hRPen = CreatePen(PS_SOLID, 2, vbBlue)
    DeleteObject SelectObject(Me.hdc, hRPen)
    Rectangle Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25
    DeleteObject hRPen

    ' 用黄色填充这个蓝色矩形
    hFFBrush = CreateSolidBrush(vbYellow)
    SelectObject Me.hdc, hFFBrush
    FloodFill Me.hdc, Me.ScaleWidth / 2, Me.ScaleHeight / 2, vbBlue
    DeleteObject hFFBrush
End Sub
Private Sub Form_Resize()
    Form_Paint
End Sub