function DeleteSelected:boolean;
procedure DrawGraph(C:TCanvas;minW,minH,maxW,maxH:integer);
procedure AddPoint(X,Y:integer;Value:integer);
function AddConnection(fromPoint,toPoint:PPoint;Value:integer):boolean;
procedure ChangeCur(dX,dY:integer);
procedure
ChangeCurAndDrawContur(X,Y,GridDelta:integer;C:TCanvas;DrawFirst,D
rawSecond:boolean);
procedure GetDeltaOfCurrent(X,Y:integer;var dX,dY:integer);
procedure SaveToFile(filename:string);
procedure OpenFromFile(filename:string);
procedure SelectCurrent;
procedure DeselectCurrent;
procedure MoveOnTop;
function IsChanged:boolean;
function WasChangedAfter:boolean;
function GetPoints:TList;
function GetConnections:TList;
function GetPointByID(ID:integer):PPoint;
procedure ZoomOn(coef:extended);
procedure ZoomOff(coef:extended);
procedure ChangeValue(Elem:CurElement;Value:integer);
function GetConsCount:integer;
function GetPointsCount:integer;
end;
PProcCon = ^TProcCon;
PProcPoint = ^TProcPoint;
TProcCon = record
Value : integer;
toPoint : PProcPoint;
Next : PProcCon;
end;
TProcPoint = record
UIN : integer;
Value : integer;
Merged : boolean;
UBorder,DBorder : integer;
UCon,DCon : integer;
UFixed,DFixed : boolean;
Prev,Next : PProcCon;
end;
PWay = ^TWay;
TWay = record
Numbers : string;
Length : integer;
Weight : integer;
Current : PProcPoint;
end;
PLinkTask = ^TLinkTask;
PProcTask = ^TProcTask;
PHolder = ^THolder;
THolder = record
Task : PProcTask;
Link : PLinkTask;
Next : PHolder;
end;
TProcTask = record
UIN : integer;
ProcNum : integer;
StartTime : integer;
Length : integer;
Prev : PHolder;
MayBeBefore : boolean;
MayBeAfter : boolean;
Ready : integer;
end;
TLinkTask = record
fromUIN : integer;
toUIN : integer;
fromProc : integer;
toProc : integer;
fromTask : PProcTask;
toTask : PProcTask;
StartTime : integer;
Length : integer;
PrevLink : PLinkTask;
PrevTask : PProcTask;
end;
PPossibleMove = ^TPossibleMove;
TPossibleMove = record
UIN : integer;
processor : integer;
afterUIN : integer;
ProcCount,Time:integer;
CurrentState : boolean;
end;
TSubMerger = class
private
Selected : PProcTask;
MinProcNum:integer;
MaxProcNum:integer;
Points : TList;
Procs : TList;
Links : TList;
AllProcTasks : Tlist;
function GetProcPointByUIN(UIN:integer):PProcPoint;
function GetProcTaskByUIN(UIN:integer):PProcTask;
procedure Clear;
procedure ClearProcs(FreeElements:boolean);
procedure ClearLinks(FreeElements:boolean);
procedure FormLinkTasksAndSetTimes(NumOfProcs:integer);
// -- Optimization -- //
procedure ClearPossibleMoves(var List:TList);
function GetPossibleMoves(UIN:integer):TList;
function GetTime:integer;
function GetProcCount:integer;
procedure SaveBackUp(var List:Tlist);
procedure RestoreBackUp(var
List:Tlist;NOP:integer;ClearCurrent:boolean);
public
constructor Create;
procedure Init(GPoints,GConnections:TList);
procedure DoBazovoe;
procedure SelectTask(UIN:integer);
procedure DeselectTask;
procedure MoveSelectedAfter(ProcNum,UIN:integer);
procedure ShowSubMerging(SG:TStringGrid);
function IncNumOfProc:boolean;
function DecNumOfProc:boolean;
function OptimizeOneStep(L1,L2:TLabel):boolean;
procedure OptimizeAuto(Form:TForm;L1,L2:TLabel);
end;
// --- --- --- //
function MinInt(I1,I2:integer):integer;
function MaxInt(I1,I2:integer):integer;
procedure MinMaxInt(I1,I2:integer;Var Min,Max:integer);
implementation
// -- Native functions -- //
function MinInt(I1,I2:integer):integer;
begin
if I1<I2 then Result:=I1 else Result:=I2
end;
function MaxInt(I1,I2:integer):integer;
begin
if I1>I2 then Result:=I1 else Result:=I2
end;
procedure MinMaxInt(I1,I2:integer;Var Min,Max:integer);
begin
if I1<I2 then
begin
Min:=I1;
Max:=I2
end
else
begin
Min:=I2;
Max:=I1
end
end;
// -- Objects -- //
function TGraph.GetConsCount:integer;
begin
Result:=Connections.Count
end;
function TGraph.GetPointsCount:integer;
begin
Result:=Points.Count
end;
procedure TGraph.ZoomOn(coef:extended);
var PP:PPoint;
i:integer;
begin
for i:=0 to Points.Count-1 do
begin
PP:=Points[i];
PP.X:=round(PP.X*coef);
PP.Y:=round(PP.Y*coef);
end;
end;
procedure TGraph.ZoomOff(coef:extended);
var PP:PPoint;
i:integer;
begin
for i:=0 to Points.Count-1 do
begin
PP:=Points[i];
PP.X:=round(PP.X/coef);
PP.Y:=round(PP.Y/coef);
end;
end;
constructor TGraph.Create;
begin
inherited Create;
MaxUIN:=0;
Points:=TList.Create;
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);