Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Рекурсия


Страницы:   1 2 3

RASkov ©   (2006-08-23 03:50:00) 

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

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) сделать рекурсивную подпрограмму. Не понимаю как вообще оформить рекурсию.

Ketmar   (2006-08-27 21:51:00) [21]

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

RASkov   (2006-08-27 21:24:00) [22]

Народ, вот посмотрел код приведенный по ссылке [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;

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

RASkov   (2006-08-24 00:36:00) [23]

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

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

Zeqfreed   (2006-08-24 00:15:00) [24]

> [26] RASkov   (23.08.06 23:41)

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

RASkov   (2006-08-23 23:41:00) [25]

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

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

Zeqfreed   (2006-08-23 23:30:00) [26]

> [24] RASkov   (23.08.06 23:25)

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

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

RASkov   (2006-08-23 23:25:00) [27]

> [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:18:00) [28]

> А по теме, что, ни у кого нет примеров (исходников 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:00:00) [29]

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

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

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

Zeqfreed   (2006-08-23 21:20:00) [30]

> [18] RASkov   (23.08.06 20:48)

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

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

RASkov   (2006-08-23 20:52:00) [31]

См. [17].

RASkov   (2006-08-23 20:51:00) [32]

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

RASkov   (2006-08-23 20:48:00) [33]

> [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:43:00) [34]

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

TUser   (2006-08-23 19:33:00) [35]

> RASkov   (23.08.06 04:50) [2]

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

Zeqfreed   (2006-08-23 19:29:00) [36]

> [14] RASkov   (23.08.06 19:12)

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

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

RASkov   (2006-08-23 19:12:00) [37]

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

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

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

MBo   (2006-08-23 15:44:00) [38]

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

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

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

Zeqfreed   (2006-08-23 15:37:00) [39]

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

RASkov   (2006-08-23 15:21:00) [40]

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

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо