Листинг 1. Модуль FloodFll.bas — процедура Paint для заливки фигуры
произвольных очертаний
Option Explicit
Private Declare Function ExtFloodFill Lib "gdi32" _
(ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, _
ByVal crColor As Long, ByVal wFillType As Long) As Long
' Значения режимов заливки
Public Enum FillModes
FLOODFILLBORDER = 0
FLOODFILLSURFACE = 1
End Enum
Public Sub Paint(ByVal Canvas As Object, ByVal X As Single, _
ByVal Y As Single, ByVal FillColor As Long, _
Optional ByVal FillStyle As FillStyleConstants = vbFSSolid, _
Optional ByVal BorderColor As Long = vbBlack, _
Optional ByVal Flags As FillModes = FLOODFILLBORDER)
' Заливка поверхности фигуры произвольных очертаний
Dim xP As Long, yP As Long
Dim oldFillColor As Long
Dim oldFillStyle As Long
' Работает только с Form и Picture
If Not TypeOf Canvas Is Form Then
If Not TypeOf Canvas Is PictureBox Then
MsgBox "Контур должен быть формой или картинкой"
Exit Sub
End If
End If
Dim PointColor As Long
' почему-то нужно обязательно выполнить операцию Point
PointColor = Canvas.Point(X, Y)
'
' Впрочем, это пригодится для установки режима заливки
' и проверки параметров
If Flags = FLOODFILLBORDER Then
If PointColor = BorderColor Then
MsgBox "Ошибка: совпадают цвета 'начальной'" & _
"точки и границы в режиме FLOODFILLBORDER"
Exit Sub
End If
Else ' в этом режиме нужно установить текущий цвет
BorderColor = PointColor
End If
' Преобразование координат (логические данного объекта) в пикселы
xP = Canvas.ScaleX(X, Canvas.ScaleMode, vbPixels)
yP = Canvas.ScaleY(Y, Canvas.ScaleMode, vbPixels)
' Сохранение текущих атрибутов и установка новых
oldFillColor = Canvas.FillColor
oldFillStyle = Canvas.FillStyle
Canvas.FillColor = FillColor
Canvas.FillStyle = FillStyle
' Заливка !
Call ExtFloodFill(Canvas.hDC, xP, yP, BorderColor, Flags)
' Восстановление значений атрибутов
Canvas.FillColor = oldFillColor
Canvas.FillStyle = oldFillStyle
End Sub