Тип заливки - Горизонтальная штриховка

  Алгоритм быстрой заливки горизонтальными линиями http://proza.ru/2020/10/16/1478 может быть легко переделан в горизонтальную штриховку. Для этого вертикальные переходы между линиями заливки нужно делать не на соседние пиксели, а пропуская три, четыре или пять рядов пикселей.

  Заливка делается внутри контура цвета Cb. Цвет заливки Ca отличается от цвета контура только наличием бита в четвёртом разряде. Расстояние между линиями штриховки регулируется параметром М. А он, в свою очередь, устанавливается по величине DWo - по размеру точки рисования.               

ПРИЛОЖЕНИЕ.     Подпрограмма заливки
'==========
Public Sub ZAL2(XX As Integer, YY As Integer, CC As Long, DWo 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 V1 As Integer, Vo As Integer, M As Integer

  Cb = CC:  = CC + 8:
  DW = Form1.Picture1.DrawWidth: Form1.Picture1.DrawWidth = 1:
  H = 200: Xo = XX - H: Xm = XX + H: Yo = YY - H: Ym = YY + H:
  Y = YY: I = XX: Y = Y / 3: Y = Y * 3:
  If DWo = 1 Or DWo = 4 Or DWo = 7 Then Y = Y + 1:
  If DWo = 3 Or DWo = 6 Or DWo = 9 Then Y = Y - 1:
  C = Form1.Picture1.Point(I, Y): If C = Cb Then Exit Sub:
  M = 4: If DWo > 6 Then M = 5:
      If DWo < 4 Then M = 3:
2 I = I - 1: 'делаем линию-затравку ============
  If I < Xo Then Form1.Picture1.DrawWidth = DW: Exit Sub:
  C = Form1.Picture1.Point(I, Y): If C = Cb Then Else GoTo 2
  I1 = I + 1
3 I = XX
4 I = I + 1:
  If I > Xm Then Form1.Picture1.DrawWidth = DW: Exit Sub:
  C = Form1.Picture1.Point(I, Y): If C = Cb 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 30
         
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) + M * 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):
   
   If C <> Cb Then 'ищем I1 слева =======================
12 I = I - 1: If I < Xo Then GoTo 13
   C = Form1.Picture1.Point(I, Y): If C = Cb Then Else GoTo 12
13 I1 = I + 1: I = X1
14 I = I + 1: If I > Xm Then GoTo 15
   C = Form1.Picture1.Point(I, Y): If C = Cb 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): If C = Cb Then GoTo 22 Else I1 = I:
23 I = I + 1: If I > Xm Then GoTo 25
   C = Form1.Picture1.Point(I, Y): If C = Cb 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 - M * 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: 'основной путь
30   Form1.Picture1.Line (I1, Y)-(I2 + 1, Y), Ca: GoTo 10 'заливаем линию
   
End Sub
'==========


Рецензии