Советы тем, кто программирует на VB & VBA

Листинг 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  

возврат

Наш канал на Youtube

1999 1 2 3 4 5 6 7 8 9 10 11 12
2000 1 2 3 4 5 6 7 8 9 10 11 12
2001 1 2 3 4 5 6 7 8 9 10 11 12
2002 1 2 3 4 5 6 7 8 9 10 11 12
2003 1 2 3 4 5 6 7 8 9 10 11 12
2004 1 2 3 4 5 6 7 8 9 10 11 12
2005 1 2 3 4 5 6 7 8 9 10 11 12
2006 1 2 3 4 5 6 7 8 9 10 11 12
2007 1 2 3 4 5 6 7 8 9 10 11 12
2008 1 2 3 4 5 6 7 8 9 10 11 12
2009 1 2 3 4 5 6 7 8 9 10 11 12
2010 1 2 3 4 5 6 7 8 9 10 11 12
2011 1 2 3 4 5 6 7 8 9 10 11 12
2012 1 2 3 4 5 6 7 8 9 10 11 12
2013 1 2 3 4 5 6 7 8 9 10 11 12
Популярные статьи
КомпьютерПресс использует