Реализовал объект многоугольник, который имеет неопределенное количество вершин. Но скорость работы с ним критическая, поэтому надо как можно сильнее его оптимизировать. Вот, что он из себя представляет:
unit Polygone; interface uses UnitTVector,ListOfVertex,objects; TPPolygone=^TPolygone; TPolygone=object List:TVertexList;//Кольцевой список constructor init;//инициализируем поля procedure AddVertex(x,y:integer);//добавляем вершину, x,y - ее координаты procedure Increase(Const vector:TVector);//Увеличиваем координаты всех вершины на вектор vector, описание - ниже procedure Decrease(Const vector:TVector);//Уменьшаем координаты всех вершины на вектор vector, описание - ниже procedure ForEach(proc:ToDO);//Проделываем процедуру типа ToDO с каждой вершиной function ContainsPoint(point:TPoint):boolean;//входит ли точка point в объект function IsInside(OtherPolyg:TPolygone):boolean;//входит ли объект в OtherPolyg function ContainsOtherPolyg(OtherPolyg:TPolygone):boolean;// входит ли OtherPolyg в объект destructor done;//Удаляем все поля end;
Кольцевой список
unit ListOfVertex; interface uses objects; type ToDo=procedure(point:TPoint);//тип процедуры, вызываемой с ForEach
TPVertexItem=^TVertexItem;//элемент списка TVertexItem=record vertex:TPoint;//информационная часть - координаты вершины next:TPVertexItem; end;
TPVertexList=^TVertexList; TVertexList=object Last:TPVertexItem; constructor init;//инициализируем поля procedure AddElement(data:TPoint);//добавляем новый элемент function DeleteElement(p:TPVertexItem):boolean;//удаляем элемент procedure ForEach(proc:ToDo);//Проделываем процедуру типа ToDO с каждым элементом destructor done;//удаляемся end;
Модуль для работы с векторами
unit UnitTVector; interface Type TVector=record X,Y:integer; end; Operator + (Const v1,v2:TVector) R:TVector; //складываем два вектора Operator - (Const v1,v2:TVector) R:TVector;//отнимаем от первого вектора второй Operator * (Const k:double; v:TVector) R:TVector;//перемножаем вектор на коэффициент k Operator * (Const v:TVector; k:double) R:TVector;//тоже самое, только другой порядок Operator / (Const v:TVector; k:double) R:TVector;//делим вектор на коэффициент
Программа для проверки минимальной работоспособности
uses crt,ListOfVertex,objects, UnitTVector, Polygone; procedure Show(p:TPoint); begin writeln('X = ',p.x,' Y = ',p.y); end;
var obj1,obj2:TPPolygone; p1:TPoint; mem:longint; vector:TVector; begin clrscr; mem:=GetHeapStatus.TotalFree; vector.x:=4; vector.y:=8; p1.x:=40; p1.y:=50; new(obj2,init); with obj2^ do begin AddVertex(30,10); AddVertex(30,20); AddVertex(50,20); AddVertex(50,10); end; new(obj1,init); with obj1^ do begin AddVertex(10,10); AddVertex(40,60); AddVertex(1000,10); writeln('First'); ForEach(show); writeln; writeln('Point x=',p1.x,' y=',p1.y); if ContainsPoint(p1) then writeln('First contains Point') else writeln('First does not contain Point'); writeln; Writeln('After decrease: '); writeln('Vector: x=',vector.x,' y=',vector.y); decrease(vector); ForEach(show); writeln; writeln('Second'); obj2^.ForEach(show); if ContainsOtherPolyg(obj2^) then writeln('First contains second object') else writeln('First does not contain second object'); if IsInside(obj2^) then writeln('Second is inside first object') else writeln('Second is not inside first object'); end; dispose(obj1,done); dispose(obj2,done); writeln; writeln('Difference: ',mem-GetHeapStatus.TotalFree); readln; end.
Три модуля вмести:Polygone.rar ( 13.71 килобайт )
Кол-во скачиваний: 428
PS в принципе код прозрачен, но если что-то не понятно - спрашивайте.
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.