Градиентная заливка. Алгоритм. Флюки

   Градиентная заливка фигур векторной графики несколько сложнее, чем однотонная, но фактически её можно делать по тому же алгоритму.
   Идея здесь всё та же - вначале лишаем квадрат заливаемой области первых битов цвета, затем рисуем контур фигуры цветом, содержащим первые биты, затем определяем начальную точку заливки внутри контура, и затем заливаем контур цветом фона  (имеющим 1 в первом бите) по принципу - закрашиваем те пиксели, которые имеют 0 в первом бите своего цвета.

   Отличие от алгоритма однотонной заливки, который был описан тут - http://proza.ru/2020/10/27/32 состоит лишь в том, что анализируются только первые биты цвета, а не цвет фона или цвет контура целиком.
   Цвета для градиентной заливки, для ускорения процесса, вычисляются заранее и помещаются в одномерный массив в количестве 100, если заливаемый квадрат имеет размер 200х200 пикселей, или в количестве 200 для квадрата 400х400.
   Градиентная заливка симметрична относительно центра квадрата, распространяясь по оси X или Y, или по более сложному правилу по двум осям одновременно, тут можно проявить фантазию в составлении правил и заливать контуры как угодно.  Кроме того, разнообразить заливку можно, по-разному располагая её начало (центр квадрата) внутри заливаемой фигуры. Примеры заливок многоугольника, ломаной линии и фигуры Безье показаны на иллюстрации справа.

Об общих принципах "быстрой" заливки смотреть тут - http://youtu.be/OkWiVZiiKS8

   ФЛЮКИ

  В ходе отработки градиентной заливки, не всё так уж прямо у меня ладилось, некоторые ошибки (как же без этого) приводили к занятным изображениям – так называемым флюкам.
   Напомню, что флюком в биллиарде называется счастливое падение шара в лузу, совершенно не предусмотренное игроком, держащим в руках кий.

   Пару таких флюков вы можете наблюдать в верхней части иллюстрации.
   Левый флюк – диагональный квадрат на фоне другого квадрата бОльших размеров, появился, когда я, работая с одной из опций, поставил начальную точку заливки вне заливаемого контура. Ожидалось-то, что получится просто квадрат, такой, как внизу, безо всяких диагоналий на нём!
   А получилось то, что получилось.
   Дело оказалось в том, что, объявив зону заливки 400х400, я заполнял для неё только 100 значений цвета в одномерном массиве, а остальные 100 оставались от заливки предыдущей. Вот и получалось «так красиво».
   Флюк этот я исправлять не стал – внутри контура заливка получается правильной, а то, что вне контура «красоты» получаются, так это даже хорошо.

   Второй флюк, тот, который на иллюстрации правее, возник из-за того, что создавая фигуру Безье тонкой линией, я не позаботился установить тип этой линии в исходное состояние. Заливка в результате произвелась, но таким оригинальным «полосатым» способом.
   Я бы оставил и этот флюк, но в строке описания графики свободных позиций нет. А иначе заливки можно было бы сделать куда как более разнообразными. Сделать их такими же, как в Corel Painter, не составляет никаких проблем.

===
дальнейшее развитие темы заливки см.тут - http://proza.ru/2020/11/08/203
_________
4.11.2020


ПРИЛОЖЕНИЕ.
Тексты подпрограмм для градиентной заливки.

Public Sub ZALc(XX As Integer, YY As Integer, V As Integer) 'подготовка цвета для рисования и заливки фигуры 37
Dim I As Integer, A As Single, A1 As Single
  If V = 0 Then Exit Sub
  OldC = (OldC And &HFEFEFE) + &H10101: cBack = (cBack And &HFEFEFE) + &H10101:
  Select Case V: Case 7, 8, 9
    A = 0: For I = 0 To 200: Cza(I) = (ccRGB(OldC, cBack, A) And &HFEFEFE) + &H10101:
    A = A + 0.005: Next I:
       Case 1, 2, 3
    A = 0: For I = 0 To 100: Cza(I) = (ccRGB(OldC, cBack, A) And &HFEFEFE) + &H10101:
    A = A + 0.01: Next I:
       Case 4
    A1 = 0: A = 0: For I = 0 To 100: Cza(I) = (ccRGB(OldC, cBack, A) And &HFEFEFE) + &H10101:
    If I > 12 Then A1 = A1 + 0.01:
    A = A1 ^ 0.6: Next I:
  End Select
End Sub


'==========
Public Sub ZAL2(XX As Integer, YY As Integer, V As Integer) 'градиентная заливка внутри контура заданного цвета
Dim Xo As Integer, Yo As Integer, Xm As Integer, Ym As Integer, Ca As Long, Cb As Long, C As Long
Dim Y As Integer, X1 As Integer, X2 As Integer, K As Integer, P As Integer, H As Integer
Dim I As Integer, I1 As Integer, I2 As Integer, DW As Integer, Pm As Integer
Dim J As Integer 'индекс одномерного массива цвета

  If V = 0 Then Exit Sub
  Cb = OldC: Ca = cBack: 'If Cb = Ca Then Exit Sub
  DW = Form1.Picture1.DrawWidth: Form1.Picture1.DrawWidth = 1:
  If V > 3 Then H = 200 Else H = 100 'размер квадрата заливки. Тут правильно V > 4, однако V > 3 оставлено для
  Xo = XX - H: Xm = XX + H: Yo = YY - H: Ym = YY + H:   'создания красиво окрашенных квадратов вне контура
  Y = YY: I = XX
2 I = I - 1: If I < Xo Then I1 = Xo + 1: GoTo 3 'делаем линию-затравку ============
  C = Form1.Picture1.Point(I, Y): If C = Cb Or C = Ca Then Else GoTo 2
  I1 = I + 1
3 I = XX
4 I = I + 1: If I > Xm Then I2 = Xm - 1: GoTo 5
  C = Form1.Picture1.Point(I, Y): If C = Cb Or C = Ca Then Else GoTo 4
  I2 = I - 1:
5  P = 2: YXXk(1, 0) = Y: YXXk(1, 1) = I1: YXXk(1, 2) = I2: YXXk(1, 3) = -1:
         YXXk(2, 0) = Y: YXXk(2, 1) = I1: YXXk(2, 2) = I2: YXXk(2, 3) = 1: 'записываем затравку в стек
     GoTo 50:
         
10 If P < 1 Then Form1.Picture1.DrawWidth = DW: Exit Sub 'ВЫХОД
   If P > Pm Then Pm = P
   K = YXXk(P, 3): Y = YXXk(P, 0) + K: X1 = YXXk(P, 1): X2 = YXXk(P, 2): P = P - 1 'читаем из стека
   If Y < Yo Or Y > Ym Then GoTo 10
   I = X1: C = Form1.Picture1.Point(I, Y) And 1:
   
   If C = 0 Then 'ищем I1 слева =======================
12 I = I - 1: If I < Xo Then GoTo 13
   C = Form1.Picture1.Point(I, Y) And 1: If C <> 0 Then Else GoTo 12 'If C = Cb Or C = Ca Then
13 I1 = I + 1: I = X1
14 I = I + 1: If I > Xm Then GoTo 15
   C = Form1.Picture1.Point(I, Y) And 1: If C <> 0 Then Else GoTo 14
15 I2 = I - 1
   If I1 < X1 - 1 Then P = P + 1: YXXk(P, 0) = Y: YXXk(P, 1) = I1: YXXk(P, 2) = X1 - 2: YXXk(P, 3) = -K:
   GoTo 26: End If
   
22 I = I + 1: If I > X2 Then GoTo 10 'ищем I1 справа ==================
   C = Form1.Picture1.Point(I, Y) And 1:
   If C <> 0 Then GoTo 22 Else I1 = I:
23 I = I + 1: If I > Xm Then GoTo 25
   C = Form1.Picture1.Point(I, Y) And 1:
   If C <> 0 Then Else GoTo 23
25 I2 = I - 1:
26 If I2 > X2 + 1 Then P = P + 1: YXXk(P, 0) = Y: YXXk(P, 1) = X2 + 2: YXXk(P, 2) = I2: YXXk(P, 3) = -K:
   If X2 > I2 + 1 Then P = P + 1: YXXk(P, 0) = Y - K: YXXk(P, 1) = I2 + 1: YXXk(P, 2) = X2: YXXk(P, 3) = K:
   P = P + 1: YXXk(P, 0) = Y: YXXk(P, 1) = I1: YXXk(P, 2) = I2: YXXk(P, 3) = K: 'основной путь

50     For I = I1 To I2: Select Case V 'рисуем линию по точкам
         Case 1, 7: J = Abs(I - XX):
         Case 2, 8: J = Abs(Y - YY):
         Case 3, 4, 9: J = Abs(I - XX) + Abs(Y - YY): J = J / 2:
       End Select: C = Cza(J): Form1.Picture1.PSet (I, Y), C: Next I

   GoTo 10
End Sub