«Заливка многоугольных областей»

Цель работы: Разработать алгоритм заполнения замкнутых многоугольных форм цветом.

Алгоритм:

1. Среди вершин многоугольника выделяем левую верхнюю и правую нижнюю точки многоугольника (MinX: MinY), (MaxX: MaxY).

2. Проверяя все точки полученного прямоугольника запоминаем точку вхождения в многоугольник и точку выхода из него. По этим двум точкам проводим линию.

Ниже приведена блок-схема организованного алгоритма.

Размещено на http://www.allbest.ru/

Размещено на http://www.allbest.ru/

алгоритм многоугольник заполнение

Размещено на http://www.allbest.ru/

Размещено на http://www.allbest.ru/

Листинг программы:

unit ULab2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, ShellAPI;

type

TMainForm = class(TForm)

PBox: TPaintBox; Button1: TButton; Button2: TButton; Label1: TLabel; Label2: TLabel;

procedure Button1Click(Sender: TObject);

procedure PBoxMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Button2Click(Sender: TObject);

procedure PBoxPaint(Sender: TObject);

procedure PBoxMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

end;

var

MainForm: TMainForm;

Coords: array of TPoint;

procedure FloodFill(X, Y: Word; FloodColor: TColor; Canvas: TCanvas);

implementation

{$R *.dfm}

procedure FloodFill(X, Y: Word; FloodColor: TColor; Canvas: TCanvas);

var i, j, MinX, MaxX, MinY, MaxY: Word;

s: TPoint;

begin

if Length(Coords) < 3 then Exit; // или точек меньше 3-х то выходим из подпрограммы

// Возьмем по-умолчанию за макс. и мин. точки самую первую в массиве

MinX:= Coords[0].X;

MaxX:= Coords[0].X;

MinY:= Coords[0].Y;

MaxY:= Coords[0].Y;

// Найдем минимальные и максимальные точки многогранника

for i:= 1 to Length(Coords) - 1 do begin

if MinX > Coords[i].X then MinX:= Coords[i].X;

if MaxX < Coords[i].X then MaxX:= Coords[i].X;

if MinY > Coords[i].Y then MinY:= Coords[i].Y;

if MaxY < Coords[i].Y then MaxY:= Coords[i].Y

end;

// Теперь внутри прямоугольника (MinX, MinY, MaxX, MaxY) проверим все пиксели на принадлежность региону

// и те, которые принадлежат ему - закрасим

Canvas.Pen.Color:= clSkyBlue; // Устанавливаем цвет пера

for i:= MinX to MaxX do begin // от левого края фигуры до правого

j:= MinY; // Начинаем с верхней границы фигуры

s.X:= -1;

While j <= MaxY do begin // Пока не опустились до нижней границы фигуры

if Canvas.Pixels[i, j] = clSkyBlue then begin // Если пиксел границы

if s.X = -1 then begin // Если точка начала не назначена

s.X:= i; // Назначаем

s.Y:= j;

While Canvas.Pixels[i, j] = clSkyBlue do j:= j + 1 // Пока не дойдем до границы фигуры опускаем координату Y

end else // иначе

if s.X > -1 then begin //Если точка начала задана

Canvas.MoveTo(s.X, s.Y + 1); // Закрашиваем линию

Canvas.LineTo(i, j);

s.X:= -1 // Сбрасываем начальную точку

end

end;

j:= j + 1 // Опускаемся на пиксел ниже по оси Y

end end; end;

procedure TMainForm.Button1Click(Sender: TObject);

begin

SetLength(Coords, 0);

InvalidateRect(Handle, nil, false)

end;

procedure TMainForm.PBoxMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

if Button = mbLeft then begin // Если нажата левая кнопка мыши

SetLength(Coords, Length(Coords) + 1); // Добавляем к динамическому массиву еще ячейку

Coords[Length(Coords) - 1].X:= X; // Запоминаем координату Х

Coords[Length(Coords) - 1].Y:= Y; // Запоминаем координату Y

InvalidateRect(Handle, nil, false) // Вызываем отрисовку формы

end

else

if Button = mbRight then begin // Если нажата правая кнопка мыши

FloodFill(X, Y, clSkyBlue, PBox.Canvas); // Вызываем заливку

SetLength(Coords, 0); // Очищаем динамический массив

end

end;

procedure TMainForm.Button2Click(Sender: TObject);

var i: Byte;

begin

if Length(Coords) < 3 then begin

Application.MessageBox('Нужно как минимум три точки', 'Внимание', MB_OK or MB_ICONWARNING);

Exit

end;

with PBox.Canvas do begin

Pen.Color:= clSkyBlue; // Цвет кисти - небесно-синий

MoveTo(Coords[0].X, Coords[0].Y); // Устанавливаем кисть в первую точку

for i:= 1 to Length(Coords) - 1 do

LineTo(Coords[i].X, Coords[i].Y); // Выводим линии поочередно от точки к точке

LineTo(Coords[0].X, Coords[0].Y) // Проводим линию из последней точки к первой

end end;

procedure TMainForm.PBoxPaint(Sender: TObject);

var i: byte;

begin

PBox.Canvas.Brush.Color:= clBlack;

PBox.Canvas.FillRect(PBox.ClientRect);

if Length(Coords) = 0 then Exit;

for i:= 0 to Length(Coords) do

PBox.Canvas.Pixels[Coords[i].X, Coords[i].Y]:= clWhite

end;

procedure TMainForm.PBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

Label2.Caption:= IntToStr(x) + ': ' + IntToStr(Y)

end;

end.

Снимок окна программы:

Вывод: При выполнении данной работы были изучены некоторые алгоритмы заполнения ограниченных многоугольных областей.

Размещено на Allbest.ru