Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

курсач / DynStruct1

.txt
Скачиваний:
17
Добавлен:
08.03.2015
Размер:
4.16 Кб
Скачать
unit DynStruct;

interface

type

tPoint = record
X, Y : integer;
end;

tSquare = array[ 1..4 ] of tPoint;

// POINTS ////////////////////////////
pPointNode = ^tPointNode; ссылка на нажатие
tPointNode = record так ка динамический то присваиваем тип запись
Next : pPointNode; переменная хранящая ссылку на след эл списка
Point : tPoint; переменная типа tPoint
end;

// SQUARES ///////////////////////////
pSquareNode = ^tSquareNode; все аналогично только для квадрата
tSquareNode = record
Next : pSquareNode;
Square : tSquare;
end;

ОПИСАНИЕ ФУНКЦИЙ И ПРОЦЕДУР

// POINTS ////////////////////////////
function InitPointList : pPointNode; возврат ссылки на начальный элемент
procedure DestroyPointList( var root : pPointNode ); удаляет все на хрен
procedure AddPointNode( root: pPointNode; X, Y : integer ); добавляет точку в конец списка

// SQUARES ///////////////////////////
function InitSquareList : pSquareNode; все тоже самое только для квадрата
procedure DestroySquareList( var root : pSquareNode );
procedure AddSquareNode( root: pSquareNode; P1, P2, P3, P4 : tPoint );

implementation ВЫПОЛНЕНИЕ ФУНКЦИЙ И ПРОЦЕДУР

function InitPointList : pPointNode; ЕЙ НИЧЕГО НЕ ПЕРЕДАЕМ, ПОТОМУ ЧТО ПОКА НИЧЕ НЕ ЗНАЕМ, НУЖЕН 1 ЭЛ СПИКА
var root : pPointNode;
begin
new(root); определяет корень списка
root^.Next := nil;
result := root; значению ф-и возвращаем ссылку на заглавный элемент
end;

procedure DestroyPointList( var root : pPointNode ); удаляем список точек, в описании передаем ссылку на заглавный элемент. var нужен для возможности дальнейшего использования
var tz : pPointNode;
begin

while root^.Next <> nil do
begin
tz := root^.Next;
root^.Next := tz^.Next;
dispose( tz );
end;

dispose( root );
root := nil;
end;

procedure AddPointNode( root : pPointNode; X, Y : integer );
var tz : pPointNode;
equalityFlag : boolean;
begin
tz := root;
equalityFlag := false;
while ( tz^.Next <> nil ) and ( not equalityFlag ) do
begin
if ( tz^.Point.X = X ) and ( tz^.Point.Y = Y ) then equalityFlag := true;
tz := tz^.Next;
end;

if ( not equalityFlag ) then
begin
new( tz^.Next );
tz := tz^.Next;
tz^.Point.X := X;
tz^.Point.Y := Y;
tz^.Next := nil;
end;
end;

function InitSquareList : pSquareNode; инициализация квадрата
var root : pSquareNode;
begin
new(root);
root^.Next := nil;
result := root;
end;

procedure DestroySquareList( var root : pSquareNode ); удаление квадрата
var tz : pSquareNode;
begin

while root^.Next <> nil do
begin
tz := root^.Next;
root^.Next := tz^.Next;
dispose( tz );
end;

dispose( root );
root := nil;
end;

function SquaresAreEqual( pts1, pts2 : tSquare ) : boolean; определяет одинаковые квадраты возврвщает либо тру либо фолс
var i, j : integer;
equal : boolean;
begin
result := true;
for i := 1 to 4 do
begin
equal := false;
for j := 1 to 4 do
if ( pts1[ i ].X = pts2[ j ].X ) and ( pts1[ i ].Y = pts2[ j ].Y ) then equal := true;
result := result and equal;
end;
end;

procedure AddSquareNode( root: pSquareNode; P1, P2, P3, P4 : tPoint );
var tz : pSquareNode;
pts : tSquare;
equalityFlag : boolean;
begin
pts[ 1 ] := P1;
pts[ 2 ] := P2;
pts[ 3 ] := P3;
pts[ 4 ] := P4;

tz := root;
equalityFlag := false;
while ( tz^.Next <> nil ) and ( not equalityFlag ) do
begin
if ( tz <> root ) and SquaresAreEqual( tz^.Square, pts ) then
equalityFlag := true;

tz := tz^.Next;
end;
equalityFlag := equalityFlag or SquaresAreEqual( tz^.Square, pts );

if not equalityFlag then
begin
new( tz^.Next );
tz := tz^.Next;
tz^.Square := pts;
tz^.Next := nil;
end;
end;

end.
Соседние файлы в папке курсач