|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
09.11.2010, 20:02 | #1 |
Регистрация: 09.11.2010
Сообщений: 3
|
Волшебная палочка
//Написать алгоритм "волшебной палочки" с доступом.
//пользователь указывает некоторую точку области, и алгоритм //выделяет границу пикселей с похожим цветом. //Возможность удаления границы. Вроде все понятно, но реализация самой этой границы не работает, как соединять эти точки не пойму. Помогите пожалуйста! uses GraphABC; var p: Picture; const Step: integer = 10; type Points = class p1: Point; p2: Point; constructor(x1, y1, x2, y2: integer); begin p1:= new Point(x1, y1); p2:= new Point(x2, y2); end; end; type Node = class data: Points; next: Node; constructor (d: Points; n: Node); begin data:= d; next:= n; end; end; //Функция, определяющая расстояние мужду 2-мя цветами function Distance(c1, c2: Color): integer; begin Result:= abs(GetRed(c1) + GetGreen(c1) + GetBlue(c1) - GetRed(c2) - GetGreen(c2) - GetBlue(c2)); end; var s: Node:= new Node;// Граница procedure FillArea(OldColor: Color; x, y: integer); begin var cur:= s; if (x < 0) or (x > Window.Width) or (y < 0) or (y > Window.Height) then exit; if (Distance(oldColor,GetPixel(x,y)) < Step) then begin var l:= x; var r:= x; while (l > 0) and (Distance(oldColor, GetPixel(x,y)) < Step) do l-= 1; while (r < Window.Width) and (Distance(oldColor,GetPixel(x,y)) < Step) do r+= 1; cur:= new Node(new Points(l, y, r, y), nil); cur:= cur.next; //Line(l + 1, y, r - 1, y, color.Black); for var i:= l + 1 to r - 1 do begin FillArea(OldColor, i, y - 1); FillArea(OldColor, i, y + 1); end; end; end; procedure Separation(n: Node); begin MoveTo(n.data.p1.X, n.data.p1.Y); while (n <> nil) do begin LineTo(n.data.p1.X, n.data.p1.X); n:= n.next; end; end; procedure MouseDown(x, y, mb: integer); begin if (mb = 1) then begin s.data:= new Points(x, y, x, y); FillArea(GetPixel(x, y), x, y); p.Draw(0, 0); Separation(s); end; end; procedure KeyDown(key: integer); begin case key of vk_f1: begin Window.Clear; p.Draw(0, 0); end; end; end; |
09.11.2010, 21:32 | #2 |
Старожил
Регистрация: 06.08.2007
Сообщений: 2,183
|
|
10.11.2010, 15:30 | #3 |
Регистрация: 09.11.2010
Сообщений: 3
|
Спс, Alter!!!!
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Волшебная клавиатура | Syltan | Операционные системы общие вопросы | 7 | 01.10.2009 20:40 |