Рекурсия

← →
RASkov (2006-08-23 03:50) [0]

Подскажите как осуществляется заливка... Ну например есть Битмап на его канве нарисовали круг тыкнули в области круга мышой и круг залился специально определенным цветом. Это только пример. Мне собственно нужно нечто похожее. Есть двумерный массив (т.е. теже самые пикселы канвы Битмапа) если этот массив спроецировать на Битмап то там тоже может быть замкнутая фигура (из чисел) и вот если указать координаты в области такой фигуры то нужно всю эту область заполнить определенным значеним. Вот дополнительное инфо

var Map: array [0..100] of array [0..100] of Integer; procedure Fill(const X, Y, NFrom, NTo: Integer); begin ????????? end;

вызов Fill(35, 45, 3, 5);

3 - это значени в Map[35][45]
5 - на это нужно заменить все 3 исходя от данной координаты(35,45) и по сторонам пока не встретится либо граница либо отличное от 3

Процедуру и вызов написал только для того что бы было лучше понять. Может и не правильно (скорее всего) описал ее, т.к. она наверняка должна быть рекурсивной или в ней (в процедуре Fill) сделать рекурсивную подпрограмму. Не понимаю как вообще оформить рекурсию.

← →
TUser © (2006-08-23 04:16) [1]

А смысл тут рекурсировать?

{
Все вершины - не отмечены
}
отметить точку, куда ткнули
for n := 1 to 101 * 101 do
for x := 0 to 100 do
for y := 0 to 100 do
if (x,y) не отмечена И покрашена исходным цветом then
if рядом есть отмеченная (x",y") then
закрасить (x",y") конечным цветом
отметить (x",y")
next n

← →
RASkov (2006-08-23 04:50) [2]

> [1] TUser © (23.08.06 04:16)

Спасибо но....
Чет я вообще не понял, здесь че, либо весь встретившийся цвет (3) заменится на (5), т. был внутри "фигуры" и снаружи... и вооще не понял приведенный пример. Что значит next n... N счетчик вроде.... или это бейсик...

← →
RASkov (2006-08-23 06:03) [3]

Подозреваю, что должно быть нечто вот такое но что-то некатит :(((

procedure Fill(const X, Y, NFrom, NTo: Integer); procedure FillCR(const C, R, N: Integer); begin Map[C][R]:=NTo; if C>0 then if Map[C-1][R]=N then FillCR(C-1, R, N); if (C>0) and (R>0) then if (Map[C-1][R-1]=N) then FillCR(C-1, R-1, N); if (R>0) then if Map[C][R-1]=N then FillCR(C, R-1, N); if (C<100) then if Map[C+1][R]=N) then FillCR(C+1, R, N); if (C<100) and (R<100) then if Map[C+1][R+1]=N)then FillCR(C+1, R+1, N); if (R<100) then if Map[C][R+1]=N then FillCR(C, R+1, N); if (C>0) and (R<100) then if Map[C-1][R+1]=N then FillCR(C-1, R+1, N); end; end; begin FillCR(X, Y, N); end;

← →
Loginov Dmitry © (2006-08-23 07:39) [4]

procedure TForm1.Timer1Timer(Sender: TObject); begin with Image1.Canvas do begin Brush.Color := RGB(Random(255), Random(255), Random(255)); FloodFill(50, 50, clBlack, fsBorder); end; end; procedure TForm1.FormCreate(Sender: TObject); begin with Image1.Canvas do Ellipse(ClipRect); end;

← →
RASkov (2006-08-23 13:30) [5]

> Loginov Dmitry © (23.08.06 07:39) [4]

Читали [0]? Вот как работает FloodFill? мне так же надо с массивом.

← →
Loginov Dmitry_ (2006-08-23 13:33) [6]

Ну тады проще всего наверно сделать это с помощью рекурсии.

← →
RASkov (2006-08-23 14:06) [7]

И я так думаю... только незнаю... как?
Может кто знает как это делается... приведет пример.
Заранее Сэнькс. Большой.

← →
MBo © (2006-08-23 14:28) [8]

procedure ЗаполнитьМассив4хсвязно(x, y, Value: Integer);
begin
Arr[x,y] := Value;
if (x < Width) and (Arr[x + 1, y] <> Value) then ЗаполнитьМассив4хсвязно(x +1, y);
то же самое с x>0, x - 1, y
... x, y + 1
... x, y - 1
end;

← →
RASkov (2006-08-23 15:15) [9]

> MBo © (23.08.06 14:28) [8]

Спасибо. Это похоже на то как я пытался делать из RASkov (23.08.06 06:03) [3] ... но работает не верно. Разница в том что у Вас сравнение истина если не равно следующее значение а у меня если равно, т.е. при Вашем случае заполнится весь массив, а мне нужно часть которая содержит значение до границ с неравным Value или другими словами выбрали ячейку со значением в ней 3, то исходя от этой, заполнить все ячейки которые содержат значение 3 - значением 5. если встретилось на пути до границы массива другое значение(даже 5) прекратить в эту сторону заполнять. Или вот еще... Есть круг на канве нарисован черным пером и закрашен наполовину красной кистью наполовину зеленой и желтым за кругом, так вот если выбрать ячейку в области круга со значеним зеленый, то заполнить ее черным оставив красную и не выходить за границы круга... дожно получится на желтом фоне круг наполовину черный на половину красный. Вот вроде подробно написал....
И вот при RASkov (23.08.06 06:03) [3] таком варианте иногда вылетает OverFlow... или как там ее.. вообщем переполнение(зацикливание). Или заполняется только та ячейка которую выбрали или вообщем нужного результата не получилось ниразу.
Вот наглядно:
55555555555555555555555555555
55555555555555555555555555555
51111111111115555555555
5133333333331555555555555
5122222222221555555555555
5111111111111555555555555
55555555555555555555555555555 так считается замкнутая фигура и если выбрать координату внутри нее со значеним 3 и указать заменит на 4 то должно быть так
55555555555555555555555555555
55555555555555555555555555555
51111111111115555555555
5144444444441555555555555
5122222222221555555555555
5111111111111555555555555
55555555555555555555555555555

а это не замкнатая

55555555555555555555555555555
55555555555555555555555555555
51111111111115555555555
5133333333331555555555555
5122222222221555555555555
511111111111555555555555
55555555555555555555555555555

и если выбрать туже самую что и при первом случае ячейку то заполняются (заменяются)и тройки и пятерки на значение 4

← →
RASkov (2006-08-23 15:18) [10]

последняя должна быть так с форматированием косяк вышел для первых двух пойдет а вот последняя тоже оказалась замкнутой поэтому здесь без выделения ну по еденицам можно понять что в нижнем правом углу дыра:
55555555555555555555555555555
55555555555555555555555555555
51111111111115555555555
5133333333331555555555555
5122222222221555555555555
511111111111555555555555
55555555555555555555555555555

← →
RASkov (2006-08-23 15:21) [11]

Если кому непонятен ход моих мыслей то спрашивайте постораюсь еще как нибудь объяснить.

← →
Zeqfreed © (2006-08-23 15:37) [12]

http://zeespot.net.ru/images/book_scan1.jpg (212 Кб)
http://zeespot.net.ru/images/book_scan2.jpg (52 Кб)

← →
MBo © (2006-08-23 15:44) [13]

>Разница в том что у Вас сравнение истина если не равно следующее значение а у меня если равно

Условие я поставил от фонаря.

>OverFlow... или как там ее.. вообщем переполнение
При рекурсии задействуется стек. Есть нерекурсивные алгоритмы заливки.
http://algolist.manual.ru/graphics/fill.php
и почти любая книжка по компьютерной графике

← →
RASkov (2006-08-23 19:12) [14]

Спасибо Вам.
Хоть там везде все на СИ, я так понимаю, но поробую чего нибудь понять.
> [13] MBo © (23.08.06 15:44)

При рекурсии задействуется стек. Есть нерекурсивные алгоритмы заливки.

А если разбить приведенный Вами или мной код на 8 процедур и из каждой вызывать следующую стек будет освобождаться?

← →
Zeqfreed © (2006-08-23 19:29) [15]

> [14] RASkov (23.08.06 19:12)

> А если разбить приведенный Вами или мной код на 8 процедур
> и из каждой вызывать следующую стек будет освобождаться?

Нет, это будет косвенная рекурсия. Стек освобождается только после выхода из функции.

← →
TUser © (2006-08-23 19:33) [16]

> RASkov (23.08.06 04:50) [2]

Кратко говоря - это алгоритм Дейкстры, немного модифицированный. НА псевдокоде. next n означает, что надо начать следующую итерацию йикла, где счетчиком является переменная n (это не совсем бейсик). Делать удобно циклом while.

← →
RASkov (2006-08-23 20:43) [17]

Нифика непонял... Нет ли у кого примера заливки на PASKAL"e в Delphi желатель быстрый, и с такими же параметрами как у FloodFill. Т.е. аналога.
Массив Map который я привел вообще-то динамический и может быть довольно "больших" размеров, например SetLength(Map,1000, 600);

← →
RASkov (2006-08-23 20:48) [18]

> [15] Zeqfreed © (23.08.06 19:29)

Т.е. есть такая схема

procedure A;
begin
B;
ned;

procedure B;
begin
C;
ned;

procedure C;
begin
A;
ned;

procedure D;
begin
A;
ned;

procedure ButtonCli...
begin
D;
end;

У какой процедуры скорее всего будет переполнение: У D или у A,B,C????

← →
RASkov (2006-08-23 20:51) [19]

соответственно B,C forward вначале описаны..

← →
RASkov (2006-08-23 20:52) [20]

См. [17].

← →
Zeqfreed © (2006-08-23 21:20) [21]

> [18] RASkov (23.08.06 20:48)

> У какой процедуры скорее всего будет переполнение: У D или
> у A,B,C????

У той, на выполнении которой кончится стек!!!!!!!!!!!!!!!!!!!!!!!

← →
RASkov (2006-08-23 23:00) [22]

> [21] Zeqfreed © (23.08.06 21:20)

И какое ограничение на стек и как можно на него повлиять или это глупость нерешаемая...?

А по теме, что, ни у кого нет примеров (исходников FloodFill"a) в делфи.

← →
Zeqfreed © (2006-08-23 23:18) [23]

> А по теме, что, ни у кого нет примеров (исходников FloodFill"a)
> в делфи.

procedure TCanvas.FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle); const FillStyles: array[TFillStyle] of Word = (FLOODFILLSURFACE, FLOODFILLBORDER); begin Changing; RequiredState([csHandleValid, csBrushValid]); Windows.ExtFloodFill(FHandle, X, Y, Color, FillStyles[FillStyle]); Changed; end;

> И какое ограничение на стек и как можно на него повлиять
> или это глупость нерешаемая...?

Project > Options > Linker: Min stack size, Max stack size.

← →
RASkov (2006-08-23 23:25) [24]

> [23] Zeqfreed © (23.08.06 23:18)

Project > Options > Linker: Min stack size, Max stack size.
Если здесь увеличить на много Max Чем это грозит?

> > А по теме, что, ни у кого нет примеров (исходников FloodFill"a)
>
> > в делфи.
>
> procedure TCanvas.FloodFill(X, Y: Integer; Color: TColor;
>
> FillStyle: TFillStyle);
> const
> FillStyles: array[TFillStyle] of Word =
> (FLOODFILLSURFACE, FLOODFILLBORDER);
> begin
> Changing;
> RequiredState([csHandleValid, csBrushValid]);
> Windows.ExtFloodFill(FHandle, X, Y, Color, FillStyles[FillStyle])
> ;
> Changed;
> end;

ЭТО Я уже видел. Тогда нужно Windows.ExtFloodFill();
Сам принцип, алгоритм заливки. Вот.
И это... описание ее из модуля Windows я тоже видел...

← →
Zeqfreed © (2006-08-23 23:30) [25]

> [24] RASkov (23.08.06 23:25)

> Если здесь увеличить на много Max Чем это грозит?

Не думаю, что будут какие-то особые проблемы, хотя тут надо спросить у более сведующих людей. А так, для программы будет меньше места в вируальном адресном пространстве доступно, но вряд ли тебе удастся забить все 2 гигабайта целиком.

← →
RASkov (2006-08-23 23:41) [26]

> [25] Zeqfreed © (23.08.06 23:30)

По поводу стека спасибо. А то что рисунки с отсканеным кодом на СИ приводил, с кодом на paskal"e (делфи) таких нет?

← →
Zeqfreed © (2006-08-24 00:15) [27]

> [26] RASkov (23.08.06 23:41)

http://home.hccnet.nl/david.dirkse/math/floodfill.html

← →
RASkov (2006-08-24 00:36) [28]

> [27] Zeqfreed © (24.08.06 00:15)

Спасибо. Будем разбираться.

← →
RASkov (2006-08-27 21:24) [29]

Народ, вот посмотрел код приведенный по ссылке [27] Zeqfreed © (24.08.06 00:15). Измучился весь, нимогу под себя подогнать... поможите бога ради. С указателями туго у меня а там еще ети... сдвиговые... and"ы. Ну вообще запутался. Я еще так понимаю, что этот код заливает все до границ т.е. если есть очерченные границы замкнутой фигуры то он зальет всю область этой фигуры без разбора присутствуют там другие области с другими значениями или нет и если это так, то мне наверное это не подойдет, или же его (код этой процедуры) надо переделать но я не смог.
Еще раз повторю (на всякий случай), мне нужно залить область со значением начиная с того какие координаты ячейки были указаны при входе в процедуру т.е. границы будут любое другое значение включая то которым заливаем и физические границы массива. И вот еще некоторые данные которые учитываются в этом случае:
сам массив - var Map: array of array of Integer;

в момент входа в процедуру становиться известно значение которое нужно залить т.е. var IntFill: Integer; procedure Fill(X,Y: Integer); begin IntFill:=Map[X,Y]; if IntFill=ToFill then Exit; //выход если пытаемся залить тем же значением что и при старте процедуры ...... end;и сообственно значение чем залить например var ToFill: Integer; ну например со значением 5 т.е. ToFill:=5;
Вот код процедуры из "ссылки": некоторые вещи я закоментировал (не стал удалять, оставил как было) жирным то что я добавил как считаю надо для этого случая. Изменения внес только в самое начало так как далее сам запутался и прошу помощи.

//было-const bordercolor : longInt = $0; //было-fillcolor : longInt = $ff00; procedure GoFill(x,y : integer); type //было-TByteBox = array[0..299,0..199] of byte; TIntBox = array of array of Integer; var PBB : ^TIntBox; //было-TByteBox dir,b : byte; x1,y1 : integer; label free,fill,nextpixel,previouspixel; begin //setup---------------- GetMem(PBB,sizeof(PBB^)); SetLength(PBB^, Cols, Rows); //Cols и Rows и зависят от того какие имеет размеры массив Map try //Было-for y1 := 0 to 199 do //Было-for x1 := 0 to 299 do for X1 := 0 to Cols do for Y1 := 0 to Rows do {if form1.paintbox1.canvas.pixels[x1,y1] = bordercolor then PBB^[x1,y1] := $40 else PBB^[x1,y1] := 0;} if Map[X1,Y1] ????? //Дальше не могу // Далее код не менял y1 := 0; for x1 := 0 to 299 do PBB^[x1,y1] := $40;//set bordercolor y1 := 199; for x1 := 0 to 299 do PBB^[x1,y1] := $40;//set bordercolor x1 := 0; for y1 := 0 to 199 do PBB^[x1,y1] := $40;//set bordercolor x1 := 299; for y1 := 0 to 199 do PBB^[x1,y1] := $40;//set bordercolor //----------startup if (PBB^[x,y] and $40) <> 0 then goto free;//if started on border PBB[x,y] := $88; //set startdir,fillbit dir := 0; nextpixel: case dir of 0 : inc(x); 1 : dec(x); 2 : dec(y); 3 : inc(y); end; if (PBB^[x,y] and $c0) <> 0 then goto previouspixel; PBB^[x,y] := $80 or dir;//record fill + entry-direction if dir <> 1 then dir := 0;//compute exit-direction goto nextpixel; previouspixel: case dir of 0 : dec(x); 1 : inc(x); 2 : inc(y); 3 : dec(y); end; b := PBB^[x,y]; inc(dir); if (b and $f) = (dir xor 1) then inc(dir);//skip entry-direction if dir > 3 then begin dir := b and $f; if dir >= 8 then goto fill else goto previouspixel; end else goto nextpixel; fill: for y := 0 to 199 do for x := 0 to 299 do if (PBB^[x,y] and $80) <> 0 then form1.paintbox1.Canvas.pixels[x,y] := fillcolor; free: finally FreeMem(PBB); end; end;

Помогите решить проблему.

← →
Ketmar © (2006-08-27 21:51) [30]

> [9] RASkov (23.08.06 15:15)
а почему заменяются "3" и "5", но игнорируется "2"? где логика?

← →
RASkov (2006-08-27 23:38) [31]

> [30] Ketmar © (27.08.06 21:51)

А Вы внимательно прочитали [9]? 3 и 5 взял от фонаря...так к примеру...
Логика в том, что если в момент входа в процедуру, в ячейки с которой надо начать заливку определенным значением, находится отличное значение от того чем нужно залить, то залить все ячейки имеющие значения равные тому которое было при входе в процедуру заливки в ячейки с учетом границ. Вот так может станет ясней... уже незнаю как объяснить:
ч - черный значение например 1
с - синий значение например 2
з - зеленый значение например 3
к - красный значение например 4
цифры номера столбцов и строк т.е. в данном случае SetLength(Map, 10, 7);

0123456789
0чччччччччч
1ччччзззччч
2сссссссссс
3сззззззззс
4скккккчччс
5сссссссссс
6ккккззссчч

выбрали ячейку Map[3,3] (находится в "фигуре" данном случае прямоугольник из 2 (синий) это границы и за них не выходим так же границей является и значение 0 (черный) внутри фигуры) в ней значение 3 (зеленый) нужно заменить на 4 (красный)
Вызываем Fill(3,3,4);
в процедуре проверяем значение Map[3,3] равно 3 и не равно 4
значит нужно заполнить значениями 4 массив Map в диапазоне где находится значение 3 с учетом границ получаем вот такое:

0123456789
0чччччччччч
1ччччзззччч //здесь остаются не тронутыми
2сссссссссс
3сккккккккс
4скккккчччс
5сссссссссс
6ккккззссчч // здесь тоже не трогаем

ух... если с форматированием косяк будет... старался чтоб не было если что подправлю.

← →
RASkov (2006-08-27 23:42) [32]

Ну да случилось у номеров столбцов пробел уплыл вначале...
и жирные нимного стали толще :)))
Уж... понятно чтоли?
Ну помогите решить долбаную задачку (проблему для меня).
[29]?????????

← →
Ketmar © (2006-08-27 23:50) [33]

> [31] RASkov (27.08.06 23:38)
попробуем проще. "граница" -- это всё, что не является значением Map[3, 3]. так?

← →
RASkov (2006-08-27 23:51) [34]

В данном примере залили зеленый красным, т.е. поменяли значения в массиве имеющие значение 3 с учетом границ грубо это 2 (синего цвета рамка), 4 и 0 (красный и черный) - имеющиеся в "рамке" из синих.... ух сам путаюсь и Вас запутываю..
Ketmar © знаю что ты не напишешь (тебе лень) и земля у тебя не круглая.... всеравно спасибо тебе. %) Надеюсь понятна логика стала или от лени нет? Всетаки читать мою писанину - это терпенья скоко надо.

← →
RASkov (2006-08-27 23:52) [35]

> [33] Ketmar © (27.08.06 23:50)

Не ожидал:))
попробуем проще. "граница" -- это всё, что не является значением Map[3, 3]. так?
Да, так. И еще конечно же реальные границы т.е. границы массива.

> [35] RASkov (27.08.06 23:52)
ты будешь смеяться, но я сейчас даже код дам. %-)

← →
RASkov (2006-08-28 00:00) [37]

> [33] Ketmar © (27.08.06 23:50)

SetLength(Map, Cols, Rows);
Границы:
значение отличное от Map[3,3] включая значение которым нужно залить, Физические: 0, Cols, Rows.

← →
RASkov (2006-08-28 00:01) [38]

procedure AreaFill (x, y: Integer; dstColor: Integer); var srcColor: Integer; procedure SimpleAreaFill (x, y: Integer); var lx, rx: Integer; begin // а вообще надо что-то делать? if (y < 0) or (y >= MAX_Y) or (map[y, x] = srcColor) or (map[y, x] = dstColor) then exit; // найдём границы текущей линии lx := x; while (lx >= 0) and (map[y, lx] = srcColor) do Dec(lx); rx := x+1; while (rx < MAX_X) and (map[y, rx] = srcColor) do Inc(rx); // покрасим for x := lx+1 to rx-1 do map[y, x] := dstColor; // а теперь всё то же самое для строк выше и ниже for x := lx+1 to rx-1 do begin SimpleAreaFill(x, y-1); SimpleAreaFill(x, y+1); end; end; begin if (x < 0) or (x >= MAX_X) or (y < 0) or (y >= MAX_Y) then exit; srcColor := map[y, x]; if srcColor = dstColor then exit; SimpleAreaFill(x, y); end;

думаю, догадаешься, что MAX_X и MAX_Y -- это размеры. что там у тебя в индексах первое -- x или y -- тоже реши сам.

конечно, алгоритм далёк от шибко оптимального, и на больших областях всё-же сожрёт весь стек. да и скоростью не блещет. зато мало кода и ясно. %-)

← →
RASkov (2006-08-28 00:36) [41]

> [40] Ketmar © (28.08.06 00:12)

Спасибо большое. Сейчас будем в очередной раз "попробывать"... Интересно твой зальет фигуру отличную от прямоугольника т.е. с впадинами и иже сними... И все же областя могут быть большими... скорость собственно не важно. Лишь бы стека хватило:) Согласен, код меньше, без указателей и без доп. массивов, поэтому мож чего и своего на этом примере сворганю....
Вот пишу ответ и читаю [39] Ketmar © (28.08.06 00:10)....чето сомнения какието не хорошие... да ладно сейчас проверю. Спасибо. Если что тема не закрыта.

> [41] RASkov (28.08.06 00:36)
если я правильно понял задачу -- зальёт. форма фигуры не важна. %-)

← →
RASkov (2006-08-28 01:34) [43]

> [39] Ketmar © (28.08.06 00:10)

Сорри за сомнения... Супер. То что надо. Это был пятый способ, до этого 4 прцеДуры закомментированы (удалить надо срочно) в моем коде. Твой способ заполняет любой сложности фигуры... есть некоторые нюансы, при некоторых обстоятельствах происходит вытекание из дыр (про дыры см [10]) при некоторых нет... но это нормально. Для моего случая. Исправил, как считаю, ошибку:
// а вообще надо что-то делать? if (y < 0) or (y >= MAX_Y) or (map[y, x] = srcColor) or (map[y, x] = dstColor) then exit;

Здесь всегда происходит выход :) Ну конечно же Map[x,y]=srcColor...
Ну это мелочи жизни... Еще раз ОГРОМНОЕ СПАСИБО. Вот уж от кого кого а от тебя не ожидал:))) Имеею ввиду твою лень:))

> [36] Ketmar © (28.08.06 00:00)
> > [35] RASkov (27.08.06 23:52)
> ты будешь смеяться, но я сейчас даже код дам. %-)

Я смеюсь... только над собой. И офигиваю над твоим кодом... до ужаса просто и РАБОТАЕТ как надо... и да, я согласен с [40] Ketmar © (28.08.06 00:12)хотя... у меня глюков не вызвало...да и скорость нормальная. По всей видимости тема ЗАКРЫТА.

> [43] RASkov (28.08.06 01:34)
ну да. ступил. %-) назову это тестом на сообразительность. %-)

а код я дал по причинам чисто ностальгическим. вспомнилось, почему-то, как сам в своё время долго думал над почти такой же задачей. %-)

а "вытекания" и прочее... на самом деле так и должно быть. потому что внутри фигуры распространение идёт по 8-ми направлениям, а на границах -- только по 4-м -- ортам. думаю, если ты понял код, то большого труда исправления не потребуют. %-)

← →
Vovan#1 (2006-08-28 01:54) [45]

2 RASkov:

Скачай по одному из адресов ниже пример использования заливки Кетмара и реализацию заливки, о которой говорил MBo, и скажи, что тебя в них не устраивает?
http://www.sendspace.com/file/2zw5rf
http://storeandserve.com/download/383361/Filler.rar.html
(P.S: Карту можно рисовать или загружать из картинки, а также увеличивать или уменьшать)

Реализации заливок (размеры карты W x H с нулевого индекса):

procedure AreaFill(x, y: Integer; dstColor: Integer); var srcColor: Integer; procedure SimpleAreaFill(xa, ya: Integer); var lx, rx: Integer; begin // а вообще надо что-то делать? if (ya < 0) or (ya >= H) or (map[xa, ya] = dstColor) then exit; // найдём границы текущей линии lx := xa; while (lx >= 0) and (map[lx, ya] = srcColor) do Dec(lx); rx := xa+1; while (rx < W) and (map[rx, ya] = srcColor) do Inc(rx); // покрасим for xa := lx+1 to rx-1 do Map[xa, ya] := dstColor; // а теперь всё то же самое для строк выше и ниже for xa := lx+1 to rx-1 do begin SimpleAreaFill(xa, ya-1); SimpleAreaFill(xa, ya+1); end; end; begin if (x < 0) or (x > W) or (y < 0) or (y > H) then exit; srcColor := Map[x, y]; if srcColor = dstColor then exit; SimpleAreaFill(x, y); end; procedure AreaFill2(x, y: Integer; dstColor: Integer); var srcColor: TColor; procedure FillColor(xa, ya: Integer); begin If Map[xa, ya] = srcColor then begin Map[xa, ya] := dstColor; If xa-1 >= 0 then FillColor(xa-1, ya); If ya-1 >= 0 then FillColor(xa, ya-1); If xa+1 < W then FillColor(xa+1, ya); If ya+1 < H then FillColor(xa, ya+1); end; end; begin srcColor := Map[x,y]; If srcColor = dstColor then Exit; If (x < 0) or (x > W) or (y < 0) or (y > H) then Exit; FillColor(x, y); end;

собственно, второй вариант -- это почти то же самое, что дал я. только у меня чуть-чуть быстрее. ненамного. %-) и несколько менее корректно обрабатываются границы.

← →
RASkov (2006-08-28 02:46) [47]

> [44] Ketmar © (28.08.06 01:45)
> а "вытекания" и прочее... на самом деле так и должно быть.
> потому что внутри фигуры распространение идёт по 8-ми направлениям,
> а на границах -- только по 4-м -- ортам. думаю, если ты
> понял код, то большого труда исправления не потребуют. %-
> )

Подправил, подрихтовал.. То что надо. Про "вытекание".... Оно как раз так и лучше что из таких дыр [10] не вытекает :)))

> [45] Vovan#1 (28.08.06 01:54)

Спасибо. Посмотрел (бегло)... нечто похожее и я пытаюсь(лся) сделать. Посмотрю получше. А я и не говорил что меня неустраивает код Кетмара, про код MBo уже писал...

Со страхом убрал +1 из rx := x+1; вроде ничего страшного не произошло...
для чего прибовляем 1? Может следует вернуть?

← →
RASkov (2006-08-28 03:11) [48]

> [45] Vovan#1 (28.08.06 01:54)

А ведь второй вариант похож на тот который я привел в [3] т.е. с него я и начинал но запутался и в тупик...:)) И ввиду того что это я придумал, я его закомментировал в первую очередь, и отложил...во дурак.:) Надо больше себе доверять....

> [47] RASkov (28.08.06 02:46)
> для чего прибовляем 1?
а зачем лишний раз проверять ячейку, которая уже проверена в предыдущем цикле? страшного ничего, просто лишняя итерация.

> [48] RASkov (28.08.06 03:11)
надо было с ручкой и бумажкой на маленьком массиве проверить. %-)

← →
RASkov (2006-08-28 12:58) [50]

> [49] Ketmar © (28.08.06 04:03)
> а зачем лишний раз проверять ячейку, которая уже проверена
> в предыдущем цикле? страшного ничего, просто лишняя итерация.

Согласен.. но при
if (y < 0)or(y >= MAX_Y)or(map[y,x]=dstColor) then exit;
впринципе да, мы ее только проверяем второй раз (не красим). Хотя и это не к чему... нужно вернуть.

> > [48] RASkov (28.08.06 03:11)
> надо было с ручкой и бумажкой на маленьком массиве проверить.
> %-)

Пробовал.... и на бумаге. Начал чуть-чуть не так... и в тупик. А размер массива собственно роли не играет. Здесь нужно всего то восемь клеток обработать исходя от центральной и так для каждой. Тут я и пропал.
Спасибо.

Рекурсия Найти похожие ветки