Курсовая работа: Градиентный метод первого порядка

Connections:=TList.Create;

Current.ceType := stNONE;

Current.element := nil;

Selected.ceType := stNONE;

Selected.element := nil;

PointRadius := 15;

WasChanged := false;

ChangedAfter := false;

end;

destructor TGraph.Destroy;

begin

Clear;

Points.Destroy;

Connections.Destroy;

inherited Destroy

end;

procedure TGraph.Clear;

begin

while Points.Count<>0 do

begin

dispose(PPoint(Points.first));

Points.delete(0);

end;

while Connections.Count<>0 do

begin

dispose(PConnection(Connections.first));

Connections.delete(0);

end;

MaxUIN:=0;

Current.ceType := stNONE;

Current.element := nil;

Selected.ceType := stNONE;

Selected.element := nil;

end;

function TGraph.DeleteSelected:boolean;

var i:integer;

PP:PPoint;

PC:PConnection;

begin

if Selected.ceType = stNONE

then Result:=false

else

begin

WasChanged:=true;

ChangedAfter:=true;

Result:=true;

if Selected.ceType = stCON then

begin

PC:=Selected.element;

for i:=0 to Connections.Count-1 do

begin

if Connections[i] = PC then

begin

Connections.delete(i);

break

end;

end;

dispose(PC);

end

else

begin

PP:=Selected.element;

for i:=0 to Points.Count-1 do

begin

if Points[i] = PP then

begin

Points.delete(i);

break

end;

end;

i:=0;

while i<Connections.Count do

begin

PC:=Connections[i];

if(PC.toPoint=PP)or(PC.fromPoint=PP)then

begin

Connections.delete(i);

dispose(PC)

end

else

i:=i+1

end;

dispose(PP)

end;

Selected.ceType:=stNONE;

Selected.element:=nil

end;

end;

procedure TGraph.MoveOnTop;

var PP:PPoint;

num:integer;

begin

if Current.ceType = stPoint then

begin

WasChanged:=true;

// ChangedAfter:=true;

PP:=Current.element;

num:=0;

while num<Points.count do

begin

if Points[num]=PP then break;

num:=num+1

end;

Points.delete(num);

Points.add(PP)

end;

end;

procedure TGraph.SelectCurrent;

begin

Selected:=Current

end;

procedure TGraph.DeselectCurrent;

begin

Selected.ceType:=stNONE;

Selected.element:=nil

end;

function TGraph.MouseOverPoint(X,Y:integer):PPoint;

var PP:PPoint;

d,i:integer;

begin

Result:=nil;

for i:=Points.Count-1 downto 0 do

begin

PP:=Points[i];

d := round(sqrt((X-PP.X)*(X-PP.X)+(Y-PP.Y)*(Y-PP.Y)));

if d<=15 then

begin

Result:=Points[i];

break

end;

end;

end;

function TGraph.MouseOverConnection(X,Y:integer):PConnection;

var PC:PConnection;

i:integer;

TX,TY,FX,FY,d:integer;

begin

Result:=nil;

for i:=Connections.Count-1 downto 0 do

begin

PC:=Connections[i];

if MinInt(PC.fromPoint.X,PC.toPoint.X) = PC.fromPoint.X then

begin

FX:=PC.fromPoint.X;

FY:=PC.fromPoint.Y;

TX:=PC.toPoint.X;

TY:=PC.toPoint.Y

end

else

begin

FX:=PC.toPoint.X;

FY:=PC.toPoint.Y;

TX:=PC.fromPoint.X;

TY:=PC.fromPoint.Y

end;

if (X>=FX-5)and(X<=TX+5)then

begin

d := (TY-FY)*X + (FX-TX)*Y + TX*FY - FX*TY;

d := abs(round(d/sqrt((TY-FY)*(TY-FY)+(FX-TX)*(FX-TX))));

if d<=5 then

begin

Result:=Connections[i];

break

end

end

end

end;

function TGraph.MouseOver(X,Y:integer):CurElement;

begin

current.element:=MouseOverPoint(X,Y);

if current.element<>nil then current.ceType:=stPOINT

else

begin

current.element:=MouseOverConnection(X,Y);

if current.element<>nil then current.ceType:=stCON

else current.ceType:=stNONE

end;

Result:=current;

end;

procedure TGraph.GetDeltaOfCurrent(X,Y:integer;var dX,dY:integer);

var PP:PPoint;

begin

PP:=current.element;

if PP<>nil then

begin

dX:=X - PP.X;

dY:=Y - PP.Y

end

else

begin

dX:=0;

dY:=0

end;

end;

procedure TGraph.ChangeCur(dX,dY:integer);

var PP:PPoint;

begin

WasChanged:=true;

// ChangedAfter:=true;

PP:=current.element;

if PP<>nil then

begin

PP.X:=PP.X+dx;

PP.Y:=PP.Y+dy

end

end;

procedure

TGraph.ChangeCurAndDrawContur(X,Y,GridDelta:integer;C:TCanvas;Dra

wFirst,DrawSecond:boolean);

var PP:PPoint;

begin

WasChanged:=true;

// ChangedAfter:=true;

if current.ceType<>stNONE then

begin

PP:=current.element;

C.Brush.Style:=bsClear;

C.Pen.Mode := pmNotXor;

C.Pen.Color:=clBlack;

C.Pen.Width:=1;

if DrawFirst then C.Ellipse(PP.X-PointRadius,PP.Y-

PointRadius,PP.X+PointRadius,PP.Y+PointRadius);

if GridDelta>1 then

begin

PP.X:=round(X/GridDelta)*GridDelta;

PP.Y:=round(Y/GridDelta)*GridDelta

end

else

begin

PP.X:=X;

PP.Y:=Y

end;

if DrawSecond then C.Ellipse(PP.X-PointRadius,PP.Y-

PointRadius,PP.X+PointRadius,PP.Y+PointRadius);

C.Pen.Mode := pmCopy;

C.Brush.Style:=bsSolid;

end;

end;

procedure getArrowCoord(Fx,Fy,Tx,Ty:integer;R,Alpha:Integer;var

Ar1X,Ar1Y,Ar2X,Ar2Y:integer);

var CosV,SinV,D,CosAd2:extended;

a,b,c,Descr:extended;

y1,y2,x1,x2:extended;

RCosAd2,RSinAd2:integer;

begin

D := sqrt((FX-TX)*(FX-TX)+(FY-TY)*(FY-TY));

if D<>0 then CosV := (FX-TX) / D else CosV:=0;

if CosV = 0 then

begin

RCosAd2 := round(R*Cos(Pi*Alpha/360));

RSinAd2 := round(R*Sin(Pi*Alpha/360));

Ar1X := TX + RSinAd2;

Ar2X := TX - RSinAd2;

if TY>FY then Ar1Y := TY - RCosAd2

else Ar1Y := TY + RCosAd2;

Ar2Y := Ar1Y;

end

else

begin

SinV := (FY-TY) / D;

CosAd2 := Cos(Pi*Alpha/360);

a:=1;

b:=-2*CosAd2*SinV;

c:=CosAd2*CosAd2-CosV*CosV;

Descr := b*b - 4*a*c;

y1 := (-b - sqrt(Descr))/(2*a);

y2 := (-b + sqrt(Descr))/(2*a);

x1 := (cosAd2 - sinV*y1) / cosV;

x2 := (cosAd2 - sinV*y2) / cosV;

Ar1X:=round(x1*R)+Tx;

Ar2X:=round(x2*R)+Tx;

Ar1Y:=round(y1*R)+Ty;

Ar2Y:=round(y2*R)+Ty;

end

end;

procedure

TGraph.DrawConnections(C:TCanvas;minW,minH,maxW,maxH:integer);

var i:integer;

PC:PConnection;

Ar1X,Ar1Y,Ar2X,Ar2Y:integer;

Poly:array[0..2]of Windows.TPoint;

D:extended;

FX,FY,TX,TY:integer;

s:string;

W,H,X,Y:integer;

begin

C.Pen.Color := clBlue;

for i:=0 to Connections.Count-1 do

begin

C.Brush.Color := clBlue;

PC:=Connections[i];

if Selected.element = PC then C.Pen.Width:=2

else C.Pen.Width:=1;

C.moveto(PC.fromPoint.X,PC.fromPoint.Y);

C.lineto(PC.toPoint.X,PC.toPoint.Y);

FX:=PC.fromPoint.X;

FY:=PC.fromPoint.Y;

TX:=PC.toPoint.X;

TY:=PC.toPoint.Y;

D := sqrt((FX-TX)*(FX-TX)+(FY-TY)*(FY-TY));

if D<>0 then

begin

TX := round( TX - PointRadius*(TX-FX)/D );

TY := round( TY - PointRadius*(TY-FY)/D );

end;

getArrowCoord(FX,FY,TX,TY,10,45,Ar1X,Ar1Y,Ar2X,Ar2Y);

//

getArrowCoord(PC.fromPoint.X,PC.fromPoint.Y,PC.toPoint.X,PC.toPoint.

Y,Poin tRadius,10,45,Ar1X,Ar1Y,Ar2X,Ar2Y);

Poly[0].x := TX;

Poly[0].y := TY;

Poly[1].x := Ar1X;

Poly[1].y := Ar1Y;

Poly[2].x := Ar2X;

Poly[2].y := Ar2Y;

C.Polygon(Poly);

s:=inttostr(PC.Value);

H:=C.TextHeight('A');

W:=C.TextWidth(s);

X:=round((FX+TX-W)/2)-3;

Y:=round((FY+TY-H)/2)-1;

C.Brush.Color := clWhite;

C.Rectangle(X,Y,X+W+7,Y+H+2);

C.Brush.style:=bsClear;

C.TextOut(X+3,Y+1,s);

C.Brush.style:=bsSolid;

{ C.moveto(Ar1X,Ar1Y);

C.lineto(PC.toPoint.X,PC.toPoint.Y);

C.moveto(Ar2X,Ar2Y);

C.lineto(PC.toPoint.X,PC.toPoint.Y);

}

end

end;

procedure

TGraph.DrawPoints(C:TCanvas;minW,minH,maxW,maxH:integer);

var i:integer;

PP:PPoint;

H,W:integer;

X1,X2,Y1,Y2:integer;

s:string;

begin

C.Brush.Style := bsSolid;

C.Brush.Color := clWhite;

C.Pen.Color := clBlack;

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

if Selected.element = PP then C.Pen.Width:=2

else C.Pen.Width:=1;

// C.Ellipse(PP.X-PointRadius,PP.Y-

PointRadius,PP.X+PointRadius,PP.Y+PointRadius+10);

X1:=PP.X-PointRadius;

Y1:=PP.Y-PointRadius;

X2:=PP.X+PointRadius;

Y2:=PP.Y+PointRadius;

if(X1<maxW)and(Y2<=maxH)and(X2>minW)and(Y2>minH)then

C.Ellipse(X1,Y1,X2,Y2);

s:=inttostr(PP.Value);

H:=C.TextHeight('A');

W:=C.TextWidth(s);

C.TextOut(round(PP.X-W/2),round(PP.Y-H/2),s)

end;

C.Brush.Style := bsClear;

C.Font.Color:=clBlack;

C.Font.Style:=[fsBold];

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

s:=inttostr(PP.UIN);

H:=C.TextHeight('A');

W:=C.TextWidth(s);

C.TextOut(round(PP.X+PointRadius-W/2),PP.Y-PointRadius-H-1,s)

end;

C.Font.Style:=[];

C.Brush.Style := bsSolid;

end;

procedure

TGraph.DrawGraph(C:TCanvas;minW,minH,maxW,maxH:integer);

begin

DrawConnections(C,minW,minH,maxW,maxH);

DrawPoints(C,minW,minH,maxW,maxH);

end;

procedure TGraph.AddPoint(X,Y:integer;Value:integer);

var PP:PPoint;

begin

WasChanged:=true;

ChangedAfter:=true;

MaxUIN:=MaxUIN+1;

new(PP);

PP.UIN:=MaxUIN;

PP.X:=X;

PP.Y:=Y;

PP.Value:=Value;

Points.Add(PP);

end;

function TGraph.CheckCicle(FP,TP:PPoint):boolean;

var List : TList;

PC:PConnection;

CurP:PPoint;

i:integer;

begin

Result:=true;

List:= TList.create;

List.add(TP);

while List.Count<>0 do

begin

CurP:=List.first;

List.delete(0);

if CurP = FP then

begin

Result:=false;

break

end;

for i:=0 to Connections.Count-1 do

begin

PC:=Connections[i];

if PC.fromPoint = CurP then List.Add(PC.toPoint)

end

end;

List.clear;

List.Destroy

end;

function

TGraph.AddConnection(fromPoint,toPoint:PPoint;Value:integer):boolean;

var PC:PConnection;

begin

if(fromPoint<>toPoint) and CheckCicle(fromPoint,toPoint) then

begin

WasChanged:=true;

ChangedAfter:=true;

new(PC);

PC.fromPoint:=fromPoint;

PC.toPoint:=toPoint;

PC.Value:=Value;

Connections.Add(PC);

Result:=true

end

else

Result:=false

end;

procedure TGraph.SaveToFile(filename:string);

var f:file;

PP:PPoint;

PC:PConnection;

i:integer;

begin

assign(f,filename);

rewrite(f,1);

BlockWrite(f,Points.Count,SizeOf(integer));

BlockWrite(f,Connections.Count,SizeOf(integer));

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

BlockWrite(f,PP,SizeOf(PP));

BlockWrite(f,PP^,SizeOf(PP^));

end;

for i:=0 to Connections.Count-1 do

begin

PC:=Connections[i];

// BlockWrite(f,PC,SizeOf(PC));

BlockWrite(f,PC^,SizeOf(PC^));

end;

close(f);

end;

procedure TGraph.OpenFromFile(filename:string);

type

PAddr = ^TAddr;

TAddr = record

Old,New:pointer;

end;

var f:file;

Addresses:TList;

PA:PAddr;

PP:PPoint;

PC:PConnection;

p:pointer;

i,NOP,NOC:integer;

procedure SetNewAddr(iOld,iNew:pointer);

var PA:PAddr;

begin

new(PA);

PA.Old:=iOld;

Pa.New:=iNew;

Addresses.add(PA)

end;

function GetNewAddr(Old:pointer):pointer;

var i:integer;

begin

Result:=nil;

for i:=0 to Addresses.Count-1 do

if PAddr(Addresses[i]).Old = Old then

begin

Result:=PAddr(Addresses[i]).New;

Break

end;

end;

begin

MaxUIN:=0;

Clear;

WasChanged:=false;

ChangedAfter:=false;

Addresses:=TList.Create;

assign(f,filename);

reset(f,1);

BlockRead(f,NOP,SizeOf(integer));

BlockRead(f,NOC,SizeOf(integer));

for i:=0 to NOP-1 do

begin

new(PP);

BlockRead(f,p,SizeOf(p));

BlockRead(f,PP^,SizeOf(PP^));

Points.Add(PP);

SetNewAddr(p,PP);

If MaxUIN < PP.UIN then MaxUIN:=PP.UIN

end;

for i:=0 to NOC-1 do

begin

new(PC);

BlockRead(f,PC^,SizeOf(PC^));

PC.toPoint:=GetNewAddr(PC.toPoint);

PC.fromPoint:=GetNewAddr(PC.fromPoint);

Connections.Add(PC);

end;

close(f);

while Addresses.Count<>0 do

begin

PA:=Addresses.first;

Addresses.Delete(0);

dispose(PA);

end;

Addresses.Destroy

end;

function TGraph.IsChanged:boolean;

begin

Result:=WasChanged

end;

function TGraph.WasChangedAfter:boolean;

begin

Result:=ChangedAfter;

ChangedAfter:=false;

end;

function TGraph.GetPointByID(ID:integer):PPoint;

var PP:PPoint;

i:integer;

begin

Result:=nil;

for i:=0 to Points.Count-1 do

begin

PP:=Points[i];

if PP.UIN=ID then

begin

Result:=PP;

break

end;

end;

end;

function TGraph.GetPoints:TList;

begin

Result:=Points

end;

function TGraph.GetConnections:TList;

begin

Result:=Connections

end;

procedure TGraph.ChangeValue(Elem:CurElement;Value:integer);

begin

if Elem.element<>nil then

begin

case Elem.ceType of

stPOINT:PPoint(Elem.element).Value:=Value;

stCON :PConnection(Elem.element).Value:=Value;

end;

WasChanged:=true;

ChangedAfter:=true

end

end;

// --- SubMerger --- //

constructor TSubMerger.Create;

begin

Points := TList.Create;

AllProcTasks := TList.Create;

Procs:=TList.Create;

Links:=TList.Create

end;

procedure TSubMerger.ClearProcs(FreeElements:boolean);

var PPT:PProcTask;

PH:PHolder;

tmpPoint:pointer;

List:TList;

begin

Selected:=nil;

while Procs.Count<>0 do

begin

List:=Procs.first;

Procs.delete(0);

while List.Count<>0 do

begin

PPT:=List.first;

List.delete(0);

PH:=PPT.Prev;

while PH<>nil do

begin

tmpPoint:=PH.Next;

dispose(PH);

PH:=tmpPoint

end;

PPT.Prev:=nil;

PPT.MayBeAfter:=false;

PPT.MayBeBefore:=false;

if FreeElements then dispose(PPT);

end;

List.destroy;

end;

if FreeElements then AllProcTasks.clear;

end;

procedure TSubMerger.ClearLinks(FreeElements:boolean);

var PLT:PLinkTask;

List:TList;

begin

while Links.Count<>0 do

begin

List:=Links.first;

Links.delete(0);

while List.Count<>0 do

begin

PLT:=List.first;

List.delete(0);

PLT.PrevLink:=nil;

PLT.PrevTask:=nil;

if FreeElements then dispose(PLT);

end;

List.destroy;

end;

end;

procedure TSubMerger.Clear;

var PPP:PProcPoint;

PPC:PProcCon;

begin

while Points.Count<>0 do

begin

PPP:=Points.first;

Points.delete(0);

while PPP.Prev<>nil do

begin

PPC:=PPP.Prev.Next;

dispose(PPP.Prev);

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9