Курсовая работа: Градиентный метод первого порядка
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);
PPP.Prev:=PPC
end;
while PPP.Next<>nil do
begin
PPC:=PPP.Next.Next;
dispose(PPP.Next);
PPP.Next:=PPC
end;
dispose(PPP)
end;
ClearLinks(true);
ClearProcs(true);
AllProcTasks.Clear;
{
while FProcTasks.Count<>0 do
begin
PPT:=FProcTasks.first;
FProcTasks.delete(0);
dispose(PPT)
end;
while FLinkTasks.Count<>0 do
begin
PLT:=FLinkTasks.first;
FLinkTasks.delete(0);
dispose(PLT)
end;
}
end;
function TSubMerger.GetProcPointByUIN(UIN:integer):PProcPoint;
var i:integer;
begin
Result:=nil;
for i:=0 to Points.Count-1 do
if PProcPoint(Points[i]).UIN = UIN then
begin
Result:=Points[i];
break
end;
end;
function TSubMerger.GetProcTaskByUIN(UIN:integer):PProcTask;
var i:integer;
begin
Result:=nil;
for i:=0 to AllProcTasks.Count-1 do
if PProcTask(AllProcTasks[i]).UIN = UIN then
begin
Result:=AllProcTasks[i];
break
end;
end;
procedure TSubMerger.Init(GPoints,GConnections:TList);
var i:integer;
PP:PPoint;
PC:PConnection;
PPP:PProcPoint;
PPC:PProcCon;
begin
Clear;
for i:=0 to GPoints.Count-1 do
begin
PP:=GPoints[i];
new(PPP);
PPP.UIN := PP.Uin;
PPP.Value := PP.Value;
PPP.UBorder:=0;
PPP.DBorder:=$8FFFFFFF;
PPP.UFixed:=false;
PPP.DFixed:=false;
PPP.UCon:=0;
PPP.DCon:=0;
PPP.Prev:=nil;
PPP.Next:=nil;
Points.Add(PPP);
end;
for i:=0 to GConnections.Count-1 do
begin
PC:=GConnections[i];
PPP := GetProcPointByUIN(PC.fromPoint.UIN);
new(PPC);
PPC.Value := PC.Value;
PPC.toPoint := GetProcPointByUIN(PC.toPoint.UIN);
PPC.Next := PPP.Next;
PPP.Next := PPC;
PPP := GetProcPointByUIN(PC.toPoint.UIN);
new(PPC);
PPC.Value := PC.Value;
PPC.toPoint := GetProcPointByUIN(PC.fromPoint.UIN);
PPC.Next := PPP.Prev;
PPP.Prev := PPC;
end;
end;
procedure SetUBorderToPPP(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
Fix:boolean;
begin
if PPP.UBorder < Value then PPP.UBorder := Value;
PPC:=PPP.Prev;
Fix:=true;
while PPC<>nil do
begin
if not PPC.toPoint.DFixed then
begin
Fix:=false;
Break
end;
PPC:=PPC.Next
end;
PPP.UFixed:=Fix
end;
procedure SetDBorderToPPP(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
Fix:boolean;
begin
if PPP.DBorder > Value then PPP.DBorder := Value;
PPC:=PPP.Next;
Fix:=true;
while PPC<>nil do
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
