mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-02 01:23:40 +02:00
5465 lines
165 KiB
ObjectPascal
5465 lines
165 KiB
ObjectPascal
{ LvlGraphCtrl
|
|
|
|
Copyright (C) 2013 Lazarus team
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the same terms as the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
}
|
|
unit LvlGraphCtrl;
|
|
{off $DEFINE LvlGraphConsistencyCheck}
|
|
{off $DEFINE CheckMinXGraph}
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$IFDEF LvlGraphConsistencyCheck}
|
|
{$ASSERTIONS ON}
|
|
{$ELSE}
|
|
{$ASSERTIONS OFF}
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, types, math, typinfo, FPimage, FPCanvas, Laz_AVL_Tree,
|
|
// LCL
|
|
LMessages, LCLType, LCLIntf, Graphics, Controls, ImgList, Forms, Themes,
|
|
// LazUtils
|
|
GraphType, LazLoggerBase, AvgLvlTree;
|
|
|
|
type
|
|
TLazCtrlPalette = array of TFPColor;
|
|
|
|
const
|
|
DefaultLvlGraphNodeImageEffect = gdeNormal;
|
|
type
|
|
TLvlGraph = class;
|
|
TLvlGraphEdge = class;
|
|
TLvlGraphLevel = class;
|
|
TLvlGraphNode = class;
|
|
TLvlGraphNodeArray = array of TLvlGraphNode;
|
|
|
|
{ TLvlGraphNode }
|
|
|
|
TLvlGraphNode = class(TPersistent)
|
|
private
|
|
FCaption: string;
|
|
FColor: TFPColor;
|
|
FDrawnCaptionRect: TRect;
|
|
FGraph: TLvlGraph;
|
|
FImageEffect: TGraphicsDrawEffect;
|
|
FImageIndex: integer;
|
|
FInEdges: TFPList; // list of TLvlGraphEdge
|
|
FDrawSize: integer;
|
|
FInWeight: single;
|
|
FLevel: TLvlGraphLevel;
|
|
FNextSelected: TLvlGraphNode;
|
|
FOutEdges: TFPList; // list of TLvlGraphEdge
|
|
FDrawPosition: integer;
|
|
FOutWeight: single;
|
|
FOverlayIndex: integer;
|
|
FPrevSelected: TLvlGraphNode;
|
|
FSelected: boolean;
|
|
FSubGraph: Integer;
|
|
FVisible: boolean;
|
|
function GetIndexInLevel: integer;
|
|
function GetInEdges(Index: integer): TLvlGraphEdge; inline;
|
|
function GetOutEdges(Index: integer): TLvlGraphEdge; inline;
|
|
procedure SetCaption(AValue: string);
|
|
procedure SetColor(AValue: TFPColor);
|
|
procedure OnLevelDestroy;
|
|
procedure SetDrawCenter(AValue: integer);
|
|
procedure SetDrawSize(AValue: integer);
|
|
procedure SetImageEffect(AValue: TGraphicsDrawEffect);
|
|
procedure SetImageIndex(AValue: integer);
|
|
procedure SetIndexInLevel(AValue: integer);
|
|
procedure SetLevel(AValue: TLvlGraphLevel);
|
|
procedure SetOverlayIndex(AValue: integer);
|
|
procedure SetSelected(AValue: boolean);
|
|
procedure SetSubGraph(AValue: Integer);
|
|
procedure SetVisible(AValue: boolean);
|
|
procedure UnbindLevel;
|
|
procedure SelectionChanged;
|
|
function GetDrawCenter: integer;
|
|
protected
|
|
property SubGraph: Integer read FSubGraph write SetSubGraph;
|
|
public
|
|
Data: Pointer; // free for user data
|
|
constructor Create(TheGraph: TLvlGraph; TheCaption: string; TheLevel: TLvlGraphLevel);
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure Invalidate;
|
|
property Color: TFPColor read FColor write SetColor;
|
|
property Caption: string read FCaption write SetCaption;
|
|
property Visible: boolean read FVisible write SetVisible;
|
|
property ImageIndex: integer read FImageIndex write SetImageIndex;
|
|
property OverlayIndex: integer read FOverlayIndex write SetOverlayIndex; // requires ImageIndex>=0
|
|
property ImageEffect: TGraphicsDrawEffect read FImageEffect write SetImageEffect default DefaultLvlGraphNodeImageEffect;
|
|
property Graph: TLvlGraph read FGraph;
|
|
function IndexOfInEdge(Source: TLvlGraphNode): integer;
|
|
function FindInEdge(Source: TLvlGraphNode): TLvlGraphEdge; virtual;
|
|
function InEdgeCount: integer; inline;
|
|
property InEdges[Index: integer]: TLvlGraphEdge read GetInEdges;
|
|
function IndexOfOutEdge(Target: TLvlGraphNode): integer;
|
|
function FindOutEdge(Target: TLvlGraphNode): TLvlGraphEdge; virtual;
|
|
function OutEdgeCount: integer;
|
|
property OutEdges[Index: integer]: TLvlGraphEdge read GetOutEdges;
|
|
function GetVisibleSourceNodes: TLvlGraphNodeArray;
|
|
function GetVisibleSourceNodesAsAVLTree: TAvlTree;
|
|
function GetVisibleTargetNodes: TLvlGraphNodeArray;
|
|
function GetVisibleTargetNodesAsAVLTree: TAvlTree;
|
|
property IndexInLevel: integer read GetIndexInLevel write SetIndexInLevel;
|
|
property Level: TLvlGraphLevel read FLevel write SetLevel;
|
|
property Selected: boolean read FSelected write SetSelected;
|
|
property NextSelected: TLvlGraphNode read FNextSelected;
|
|
property PrevSelected: TLvlGraphNode read FPrevSelected;
|
|
property DrawPosition: integer read FDrawPosition write FDrawPosition; // position in a level
|
|
property DrawSize: integer read FDrawSize write SetDrawSize default 1;
|
|
property DrawCenter: integer read GetDrawCenter write SetDrawCenter;
|
|
function DrawPositionEnd: integer;// = DrawPosition+Max(InSize,OutSize)
|
|
property DrawnCaptionRect: TRect read FDrawnCaptionRect; // last draw position of caption with scrolling
|
|
property InWeight: single read FInWeight; // total weight of InEdges
|
|
property OutWeight: single read FOutWeight; // total weight of OutEdges
|
|
end;
|
|
TLvlGraphNodeClass = class of TLvlGraphNode;
|
|
PLvlGraphNode = ^TLvlGraphNode;
|
|
|
|
{ TLvlGraphEdge }
|
|
|
|
TLvlGraphEdge = class(TPersistent)
|
|
private
|
|
FBackEdge: boolean;
|
|
FNoGapCircle: boolean; // a circle between 2 nodes, with no levels between => both edges paint in the same location
|
|
FDrawnAt: TRect;
|
|
FHighlighted: boolean;
|
|
FSource: TLvlGraphNode;
|
|
FTarget: TLvlGraphNode;
|
|
FWeight: single;
|
|
procedure SetHighlighted(AValue: boolean);
|
|
procedure SetWeight(AValue: single);
|
|
protected
|
|
procedure RevertDirection;
|
|
public
|
|
Data: Pointer; // free for user data
|
|
constructor Create(TheSource: TLvlGraphNode; TheTarget: TLvlGraphNode);
|
|
destructor Destroy; override;
|
|
property Source: TLvlGraphNode read FSource;
|
|
property Target: TLvlGraphNode read FTarget;
|
|
property Weight: single read FWeight write SetWeight; // >=0
|
|
function IsBackEdge: boolean;
|
|
property BackEdge: boolean read FBackEdge; // edge had its direction reverted (source <> target exchanged)
|
|
property Highlighted: boolean read FHighlighted write SetHighlighted;
|
|
property DrawnAt: TRect read FDrawnAt; // last drawn with scrolling
|
|
function GetVisibleSourceNodes: TLvlGraphNodeArray;
|
|
function GetVisibleSourceNodesAsAVLTree: TAvlTree;
|
|
function GetVisibleTargetNodes: TLvlGraphNodeArray;
|
|
function GetVisibleTargetNodesAsAVLTree: TAvlTree;
|
|
function AsString: string;
|
|
end;
|
|
TLvlGraphEdgeClass = class of TLvlGraphEdge;
|
|
TLvlGraphEdgeArray = array of TLvlGraphEdge;
|
|
PLvlGraphEdge = ^TLvlGraphEdge;
|
|
|
|
{ TLvlGraphLevel }
|
|
|
|
TLvlGraphLevel = class(TPersistent)
|
|
private
|
|
FGraph: TLvlGraph;
|
|
FIndex: integer;
|
|
fNodes: TFPList;
|
|
FDrawPosition: integer;
|
|
function GetNodes(Index: integer): TLvlGraphNode;
|
|
procedure SetDrawPosition(AValue: integer);
|
|
procedure MoveNode(Node: TLvlGraphNode; NewIndexInLevel: integer);
|
|
public
|
|
Data: Pointer; // free for user data
|
|
constructor Create(TheGraph: TLvlGraph; TheIndex: integer);
|
|
destructor Destroy; override;
|
|
procedure Invalidate;
|
|
property Nodes[Index: integer]: TLvlGraphNode read GetNodes; default;
|
|
function IndexOf(Node: TLvlGraphNode): integer;
|
|
function Count: integer;
|
|
function GetTotalInOutWeights: single; // sum of all nodes Max(InWeight,OutWeight)
|
|
property Index: integer read FIndex;
|
|
property Graph: TLvlGraph read FGraph;
|
|
property DrawPosition: integer read FDrawPosition write SetDrawPosition;
|
|
end;
|
|
TLvlGraphLevelClass = class of TLvlGraphLevel;
|
|
|
|
{ TLvlGraphSubGraph }
|
|
|
|
TLvlGraphSubGraph = class(TPersistent)
|
|
private
|
|
FGraph: TLvlGraph;
|
|
FHighestLevel: integer;
|
|
FIndex: integer;
|
|
FLowestLevel: integer;
|
|
public
|
|
constructor Create(TheGraph: TLvlGraph; TheIndex: integer);
|
|
destructor Destroy; override;
|
|
property Graph: TLvlGraph read FGraph;
|
|
property Index: integer read FIndex;
|
|
property LowestLevel: integer read FLowestLevel;
|
|
property HighestLevel: integer read FHighestLevel;
|
|
end;
|
|
|
|
TOnLvlGraphStructureChanged = procedure(Sender, Element: TObject;
|
|
Operation: TOperation) of object;
|
|
|
|
TLvlGraphEdgeSplitMode = (
|
|
lgesNone,
|
|
lgesSeparate, // create for each edge separate hidden nodes, this creates a lot of hidden nodes
|
|
lgesMergeSource, // combine hidden nodes at source (outgoing edge)
|
|
lgesMergeTarget, // combine hidden nodes at target (incoming edge)
|
|
lgesMergeHighest // combine hidden nodes at source or target, whichever has more edges
|
|
);
|
|
|
|
{ TLvlGraph }
|
|
|
|
TLvlGraph = class(TPersistent)
|
|
private
|
|
FEdgeClass: TLvlGraphEdgeClass;
|
|
FFirstSelected: TLvlGraphNode;
|
|
FLastSelected: TLvlGraphNode;
|
|
FLevelClass: TLvlGraphLevelClass;
|
|
FNodeClass: TLvlGraphNodeClass;
|
|
FOnInvalidate: TNotifyEvent;
|
|
FNodes: TFPList; // list of TLvlGraphNode
|
|
fLevels: TFPList;
|
|
fSubGraphs: TFPList;
|
|
FCaseSensitive: Boolean;
|
|
FOnSelectionChanged: TNotifyEvent;
|
|
FOnStructureChanged: TOnLvlGraphStructureChanged;
|
|
function GetLevelCount: integer;
|
|
function GetLevels(Index: integer): TLvlGraphLevel;
|
|
function GetNodes(Index: integer): TLvlGraphNode;
|
|
function GetSubGraphCount: integer;
|
|
function GetSubGraphs(Index: integer): TLvlGraphSubGraph;
|
|
procedure SetLevelCount(AValue: integer);
|
|
procedure InternalRemoveNode(Node: TLvlGraphNode);
|
|
procedure InternalRemoveLevel(Lvl: TLvlGraphLevel);
|
|
protected
|
|
procedure SelectionChanged;
|
|
function NewLevelAtIndex(AnIndex, ASubGraphIndex: integer): TLvlGraphLevel;
|
|
public
|
|
Data: Pointer; // free for user data
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
|
|
procedure Invalidate;
|
|
procedure StructureChanged(Element: TObject; Operation: TOperation);
|
|
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
|
|
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
|
|
property OnStructureChanged: TOnLvlGraphStructureChanged read FOnStructureChanged write FOnStructureChanged;// node, edge, level was added/deleted
|
|
|
|
// nodes
|
|
function NodeCount: integer;
|
|
property Nodes[Index: integer]: TLvlGraphNode read GetNodes;
|
|
function GetNode(aCaption: string; CreateIfNotExists: boolean): TLvlGraphNode;
|
|
function CreateHiddenNode(Level: integer = 0): TLvlGraphNode;
|
|
property NodeClass: TLvlGraphNodeClass read FNodeClass;
|
|
property FirstSelected: TLvlGraphNode read FFirstSelected;
|
|
property LastSelected: TLvlGraphNode read FLastSelected;
|
|
procedure ClearSelection;
|
|
procedure SingleSelect(Node: TLvlGraphNode);
|
|
function IsMultiSelection: boolean;
|
|
property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
|
|
|
|
// edges
|
|
function GetEdge(SourceCaption, TargetCaption: string;
|
|
CreateIfNotExists: boolean): TLvlGraphEdge;
|
|
function GetEdge(Source, Target: TLvlGraphNode;
|
|
CreateIfNotExists: boolean): TLvlGraphEdge;
|
|
property EdgeClass: TLvlGraphEdgeClass read FEdgeClass;
|
|
|
|
property SubGraphs[Index: integer]: TLvlGraphSubGraph read GetSubGraphs;
|
|
property SubGraphCount: integer read GetSubGraphCount;
|
|
// levels
|
|
property Levels[Index: integer]: TLvlGraphLevel read GetLevels;
|
|
property LevelCount: integer read GetLevelCount write SetLevelCount;
|
|
property LevelClass: TLvlGraphLevelClass read FLevelClass;
|
|
|
|
procedure FindIndependentGraphs;
|
|
procedure CreateTopologicalLevels(HighLevels, ReduceBackEdges: boolean); // create levels from edges
|
|
procedure MinimizeEdgeLens(HighLevels: boolean); // requires that BackEdge have been processed by procedure MarkBackEdges
|
|
procedure LimitLevelHeights(MaxHeight: integer; MaxHeightRel: Single);
|
|
procedure SplitLongEdges(SplitMode: TLvlGraphEdgeSplitMode); // split long edges by adding hidden nodes
|
|
procedure ScaleNodeDrawSizes(NodeGapAbove, NodeGapBelow,
|
|
HardMaxTotal, HardMinOneNode, SoftMaxTotal, SoftMinOneNode: integer; out PixelPerWeight: single);
|
|
procedure SetAllNodeDrawSizes(PixelPerWeight: single = 1.0; MinWeight: single = 0.0);
|
|
procedure MarkBackEdges;
|
|
procedure MinimizeCrossings; // permutate nodes to minimize crossings
|
|
procedure MinimizeOverlappings(MinPos: integer = 0;
|
|
NodeGapAbove: integer = 1; NodeGapBelow: integer = 1;
|
|
aLevel: integer = -1); // set all Node.Position to minimize overlappings
|
|
procedure StraightenGraph;
|
|
procedure SetColors(Palette: TLazCtrlPalette);
|
|
|
|
// debugging
|
|
procedure WriteDebugReport(Msg: string);
|
|
procedure ConsistencyCheck(WithBackEdge: boolean);
|
|
end;
|
|
|
|
type
|
|
TLvlGraphCtrlOption = (
|
|
lgoAutoLayout, // automatic graph layout after graph was changed
|
|
lgoReduceBackEdges, // CreateTopologicalLevels (AutoLayout) will attempts to find an order with less BackEdges
|
|
lgoHighLevels, // put nodes topologically at higher levels
|
|
lgoMinimizeEdgeLens, // If nodes are not fixed to a level by neighbours on both side, find the level which reduces total edge len the most
|
|
lgoStraightenGraph, // Minimize vertical up/down movement of edges
|
|
lgoHighlightNodeUnderMouse, // when mouse over node highlight node and its edges
|
|
lgoHighlightEdgeNearMouse, // when mouse near an edge highlight edge and its edges, lgoHighlightNodeUnderMouse takes precedence
|
|
lgoMouseSelects
|
|
);
|
|
TLvlGraphCtrlOptions = set of TLvlGraphCtrlOption;
|
|
const
|
|
DefaultLvlGraphCtrlOptions = [lgoAutoLayout, lgoStraightenGraph,
|
|
lgoHighlightNodeUnderMouse,lgoHighlightEdgeNearMouse,lgoMouseSelects];
|
|
|
|
type
|
|
TLvlGraphNodeCaptionPosition = (
|
|
lgncLeft,
|
|
lgncTop,
|
|
lgncRight,
|
|
lgncBottom
|
|
);
|
|
TLvlGraphNodeCaptionPositions = set of TLvlGraphNodeCaptionPosition;
|
|
|
|
TLvlGraphNodeShape = (
|
|
lgnsNone,
|
|
lgnsRectangle,
|
|
lgnsEllipse
|
|
);
|
|
TLvlGraphNodeShapes = set of TLvlGraphNodeShape;
|
|
|
|
TLvlGraphNodeColoring = (
|
|
lgncNone,
|
|
lgncRGB
|
|
);
|
|
TLvlGraphNodeColorings = set of TLvlGraphNodeColoring;
|
|
|
|
const
|
|
// node style
|
|
DefaultLvlGraphNodeWith = 10;
|
|
DefaultLvlGraphNodeCaptionScale = 0.7;
|
|
DefaultLvlGraphNodeCaptionPosition = lgncTop;
|
|
DefaultLvlGraphNodeGapLeft = 2;
|
|
DefaultLvlGraphNodeGapRight = 2;
|
|
DefaultLvlGraphNodeGapTop = 1;
|
|
DefaultLvlGraphNodeGapBottom = 1;
|
|
DefaultLvlGraphNodeShape = lgnsRectangle;
|
|
DefaultLvlGraphNodeColoring = lgncRGB;
|
|
|
|
type
|
|
TLvlGraphEdgeShape = (
|
|
lgesStraight,
|
|
lgesCurved
|
|
);
|
|
TLvlGraphEdgeShapes = set of TLvlGraphEdgeShape;
|
|
|
|
const
|
|
// edge style
|
|
DefaultLvlGraphEdgeSplitMode = lgesMergeHighest;
|
|
DefaultLvlGraphEdgeNearMouseDistMax = 5;
|
|
DefaultLvlGraphEdgeShape = lgesCurved;
|
|
DefaultLvlGraphEdgeColor = clSilver;
|
|
DefaultLvlGraphEdgeHighlightColor = clBlack;
|
|
DefaultLvlGraphEdgeBackColor = clRed;
|
|
DefaultLvlGraphEdgeBackHighlightColor = clBlue;
|
|
DefaultMaxLevelHeightAbs = 0;
|
|
DefaultMaxLevelHeightRel = single(1.5);
|
|
|
|
type
|
|
|
|
TCustomLvlGraphControl = class;
|
|
|
|
{ TLvlGraphNodeStyle }
|
|
|
|
TLvlGraphNodeStyle = class(TPersistent)
|
|
private
|
|
FCaptionPosition: TLvlGraphNodeCaptionPosition;
|
|
FCaptionScale: single;
|
|
FColoring: TLvlGraphNodeColoring;
|
|
FControl: TCustomLvlGraphControl;
|
|
FDefaultImageIndex: integer;
|
|
FGapBottom: integer;
|
|
FGapLeft: integer;
|
|
FGapRight: integer;
|
|
FGapTop: integer;
|
|
FShape: TLvlGraphNodeShape;
|
|
FWidth: integer;
|
|
procedure SetCaptionPosition(AValue: TLvlGraphNodeCaptionPosition);
|
|
procedure SetCaptionScale(AValue: single);
|
|
procedure SetColoring(AValue: TLvlGraphNodeColoring);
|
|
procedure SetDefaultImageIndex(AValue: integer);
|
|
procedure SetGapBottom(AValue: integer);
|
|
procedure SetGapLeft(AValue: integer);
|
|
procedure SetGapRight(AValue: integer);
|
|
procedure SetGapTop(AValue: integer);
|
|
procedure SetShape(AValue: TLvlGraphNodeShape);
|
|
procedure SetWidth(AValue: integer);
|
|
public
|
|
constructor Create(AControl: TCustomLvlGraphControl);
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function Equals(Obj: TObject): boolean; override;
|
|
property Control: TCustomLvlGraphControl read FControl;
|
|
published
|
|
property CaptionPosition: TLvlGraphNodeCaptionPosition
|
|
read FCaptionPosition write SetCaptionPosition default DefaultLvlGraphNodeCaptionPosition;
|
|
property CaptionScale: single read FCaptionScale write SetCaptionScale default DefaultLvlGraphNodeCaptionScale;
|
|
property Shape: TLvlGraphNodeShape read FShape write SetShape default DefaultLvlGraphNodeShape;
|
|
property GapLeft: integer read FGapLeft write SetGapLeft default DefaultLvlGraphNodeGapLeft; // used by AutoLayout
|
|
property GapTop: integer read FGapTop write SetGapTop default DefaultLvlGraphNodeGapTop; // used by AutoLayout
|
|
property GapRight: integer read FGapRight write SetGapRight default DefaultLvlGraphNodeGapRight; // used by AutoLayout
|
|
property GapBottom: integer read FGapBottom write SetGapBottom default DefaultLvlGraphNodeGapBottom; // used by AutoLayout
|
|
property Width: integer read FWidth write SetWidth default DefaultLvlGraphNodeWith;
|
|
property DefaultImageIndex: integer read FDefaultImageIndex write SetDefaultImageIndex;
|
|
property Coloring: TLvlGraphNodeColoring read FColoring write SetColoring;
|
|
end;
|
|
|
|
{ TLvlGraphEdgeStyle }
|
|
|
|
TLvlGraphEdgeStyle = class(TPersistent)
|
|
private
|
|
FBackColor: TColor;
|
|
FColor: TColor;
|
|
FControl: TCustomLvlGraphControl;
|
|
FBackHighlightColor: TColor;
|
|
FHighlightColor: TColor;
|
|
FMouseDistMax: integer;
|
|
FShape: TLvlGraphEdgeShape;
|
|
FSplitMode: TLvlGraphEdgeSplitMode;
|
|
procedure SetBackColor(AValue: TColor);
|
|
procedure SetColor(AValue: TColor);
|
|
procedure SetBackHighlightColor(AValue: TColor);
|
|
procedure SetHighlightColor(AValue: TColor);
|
|
procedure SetMouseDistMax(AValue: integer);
|
|
procedure SetShape(AValue: TLvlGraphEdgeShape);
|
|
procedure SetSplitMode(AValue: TLvlGraphEdgeSplitMode);
|
|
public
|
|
constructor Create(AControl: TCustomLvlGraphControl);
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function Equals(Obj: TObject): boolean; override;
|
|
property Control: TCustomLvlGraphControl read FControl;
|
|
published
|
|
property SplitMode: TLvlGraphEdgeSplitMode read FSplitMode write SetSplitMode default DefaultLvlGraphEdgeSplitMode;
|
|
property MouseDistMax: integer read FMouseDistMax write SetMouseDistMax default DefaultLvlGraphEdgeNearMouseDistMax;
|
|
property Shape: TLvlGraphEdgeShape read FShape write SetShape default DefaultLvlGraphEdgeShape;
|
|
property Color: TColor read FColor write SetColor default DefaultLvlGraphEdgeColor;
|
|
property BackColor: TColor read FBackColor write SetBackColor default DefaultLvlGraphEdgeBackColor;
|
|
property HighlightColor: TColor read FHighlightColor write SetHighlightColor default DefaultLvlGraphEdgeHighlightColor;
|
|
property BackHighlightColor: TColor read FBackHighlightColor write SetBackHighlightColor default DefaultLvlGraphEdgeBackHighlightColor;
|
|
end;
|
|
|
|
{ TLvlGraphLimits }
|
|
|
|
TLvlGraphLimits = class(TPersistent)
|
|
private
|
|
FControl: TCustomLvlGraphControl;
|
|
FMaxLevelHeightAbs: integer;
|
|
FMaxLevelHeightRel: single;
|
|
procedure SetMaxLevelHeightAbs(AValue: integer);
|
|
procedure SetMaxLevelHeightRel(AValue: single);
|
|
public
|
|
constructor Create(AControl: TCustomLvlGraphControl);
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function Equals(Obj: TObject): boolean; override;
|
|
property Control: TCustomLvlGraphControl read FControl;
|
|
published
|
|
// Maximum amount of visible (user specified nodes) in a level. (0 = ignore)
|
|
property MaxLevelHeightAbs: integer read FMaxLevelHeightAbs write SetMaxLevelHeightAbs default DefaultMaxLevelHeightAbs;
|
|
// Relative max amount of visible nodes per level. Limit := Max(3, sqr(NodeCount) * MaxLevelHeightRel) / (0 = ignore)
|
|
property MaxLevelHeightRel: single read FMaxLevelHeightRel write SetMaxLevelHeightRel default DefaultMaxLevelHeightRel;
|
|
end;
|
|
|
|
TLvlGraphControlFlag = (
|
|
lgcNeedInvalidate,
|
|
lgcNeedAutoLayout,
|
|
lgcIgnoreGraphInvalidate,
|
|
lgcUpdatingScrollBars,
|
|
lgcFocusedPainting
|
|
);
|
|
TLvlGraphControlFlags = set of TLvlGraphControlFlag;
|
|
|
|
TLvlGraphMinimizeOverlappingsEvent = procedure(var MinPos: integer;
|
|
var NodeGapInFront: integer; var NodeGapBehind: integer;
|
|
var Handled: Boolean) of object;
|
|
TLvlGraphDrawStep = (
|
|
lgdsBackground,
|
|
lgdsHeader,
|
|
lgdsNormalEdges,
|
|
lgdsNodeCaptions,
|
|
lgdsHighlightedEdges,
|
|
lgdsNodes,
|
|
lgdsFinish
|
|
);
|
|
TLvlGraphDrawSteps = set of TLvlGraphDrawStep;
|
|
TLvlGraphDrawEvent = procedure(Step: TLvlGraphDrawStep; var Skip: boolean) of object;
|
|
|
|
{ TCustomLvlGraphControl }
|
|
|
|
TCustomLvlGraphControl = class(TCustomControl)
|
|
private
|
|
FEdgeStyle: TLvlGraphEdgeStyle;
|
|
FEdgeNearMouse: TLvlGraphEdge;
|
|
FGraph: TLvlGraph;
|
|
FImageChangeLink: TChangeLink;
|
|
FImages: TCustomImageList;
|
|
FLimits: TLvlGraphLimits;
|
|
FNodeStyle: TLvlGraphNodeStyle;
|
|
FNodeUnderMouse: TLvlGraphNode;
|
|
FOnDrawStep: TLvlGraphDrawEvent;
|
|
FOnEndAutoLayout: TNotifyEvent;
|
|
FOnMinimizeCrossings: TNotifyEvent;
|
|
FOnMinimizeOverlappings: TLvlGraphMinimizeOverlappingsEvent;
|
|
FOnSelectionChanged: TNotifyEvent;
|
|
FOnStartAutoLayout: TNotifyEvent;
|
|
FOptions: TLvlGraphCtrlOptions;
|
|
FPixelPerWeight: single;
|
|
FScrollLeft: integer;
|
|
FScrollLeftMax: integer;
|
|
FScrollTopMax: integer;
|
|
FScrollTop: integer;
|
|
fUpdateLock: integer;
|
|
FFlags: TLvlGraphControlFlags;
|
|
procedure ColorNodesRandomRGB;
|
|
procedure DrawCaptions(const TxtH: integer);
|
|
procedure ComputeEdgeCoords;
|
|
procedure DrawEdges(Highlighted: boolean);
|
|
procedure DrawNodes;
|
|
function GetSelectedNode: TLvlGraphNode;
|
|
procedure SetEdgeNearMouse(AValue: TLvlGraphEdge);
|
|
procedure SetImages(AValue: TCustomImageList);
|
|
procedure SetNodeStyle(AValue: TLvlGraphNodeStyle);
|
|
procedure SetNodeUnderMouse(AValue: TLvlGraphNode);
|
|
procedure SetOptions(AValue: TLvlGraphCtrlOptions);
|
|
procedure SetScrollLeft(AValue: integer);
|
|
procedure SetScrollTop(AValue: integer);
|
|
procedure SetSelectedNode(AValue: TLvlGraphNode);
|
|
procedure UpdateScrollBars;
|
|
procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL;
|
|
procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL;
|
|
procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
|
|
procedure ImageListChange(Sender: TObject);
|
|
protected
|
|
procedure GraphInvalidate(Sender: TObject); virtual;
|
|
procedure GraphSelectionChanged(Sender: TObject); virtual;
|
|
procedure GraphStructureChanged(Sender, Element: TObject; Operation: TOperation); virtual;
|
|
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
|
|
procedure DoStartAutoLayout; virtual;
|
|
procedure DoMinimizeCrossings; virtual;
|
|
procedure DoAutoLayoutLevels(TxtHeight: integer); virtual;
|
|
procedure DoMinimizeOverlappings(MinPos: integer = 0;
|
|
NodeGapInFront: integer = 1; NodeGapBehind: integer = 1); virtual;
|
|
procedure DoEndAutoLayout; virtual;
|
|
procedure DoDrawEdge(Edge: TLvlGraphEdge); virtual; // draw line at Edge.DrawX1,Y1,X2,Y2 with current Canvas colors
|
|
procedure Paint; override;
|
|
function Draw(Step: TLvlGraphDrawStep): boolean; virtual;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer
|
|
); override;
|
|
procedure CreateWnd; override;
|
|
procedure HighlightConnectedEgdes(Element: TObject);
|
|
procedure DoOnShowHint(HintInfo: PHintInfo); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure EraseBackground({%H-}DC: HDC); override;
|
|
property Graph: TLvlGraph read FGraph;
|
|
procedure Clear;
|
|
procedure AutoLayout; virtual;
|
|
procedure Invalidate; override;
|
|
procedure InvalidateAutoLayout;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
function GetNodeAt(X,Y: integer): TLvlGraphNode;
|
|
function GetEdgeAt(X,Y: integer; out Distance: integer): TLvlGraphEdge;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
function GetDrawSize: TPoint;
|
|
public
|
|
property NodeStyle: TLvlGraphNodeStyle read FNodeStyle write SetNodeStyle;
|
|
property NodeUnderMouse: TLvlGraphNode read FNodeUnderMouse write SetNodeUnderMouse;
|
|
property EdgeNearMouse: TLvlGraphEdge read FEdgeNearMouse write SetEdgeNearMouse;
|
|
property EdgeStyle: TLvlGraphEdgeStyle read FEdgeStyle;
|
|
property Limits: TLvlGraphLimits read FLimits;
|
|
property Options: TLvlGraphCtrlOptions read FOptions write SetOptions default DefaultLvlGraphCtrlOptions;
|
|
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
|
|
property ScrollTop: integer read FScrollTop write SetScrollTop;
|
|
property ScrollTopMax: integer read FScrollTopMax;
|
|
property ScrollLeft: integer read FScrollLeft write SetScrollLeft;
|
|
property ScrollLeftMax: integer read FScrollLeftMax;
|
|
property OnMinimizeCrossings: TNotifyEvent read FOnMinimizeCrossings write FOnMinimizeCrossings;// provide an alternative minimize crossing algorithm
|
|
property OnMinimizeOverlappings: TLvlGraphMinimizeOverlappingsEvent read FOnMinimizeOverlappings write FOnMinimizeOverlappings;// provide an alternative minimize overlappings algorithm
|
|
property OnStartAutoLayout: TNotifyEvent read FOnStartAutoLayout write FOnStartAutoLayout;
|
|
property OnEndAutoLayout: TNotifyEvent read FOnEndAutoLayout write FOnEndAutoLayout;
|
|
property OnDrawStep: TLvlGraphDrawEvent read FOnDrawStep write FOnDrawStep;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property PixelPerWeight: single read FPixelPerWeight;
|
|
property SelectedNode: TLvlGraphNode read GetSelectedNode write SetSelectedNode;
|
|
property ShowHint default True;
|
|
end;
|
|
|
|
{ TLvlGraphControl }
|
|
|
|
TLvlGraphControl = class(TCustomLvlGraphControl)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property BorderWidth;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property EdgeStyle;
|
|
property Enabled;
|
|
property Font;
|
|
property NodeStyle;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawStep;
|
|
property OnEndAutoLayout;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMinimizeCrossings;
|
|
property OnMinimizeOverlappings;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnSelectionChanged;
|
|
property OnShowHint;
|
|
property OnStartAutoLayout;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
property Options;
|
|
property ParentColor default False;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop default True;
|
|
property Tag;
|
|
property Visible;
|
|
end;
|
|
|
|
function GetCCPaletteRGB(Cnt: integer; Shuffled: boolean): TLazCtrlPalette;
|
|
procedure ShuffleCCPalette({%H-}Palette: TLazCtrlPalette);
|
|
function Darker(const c: TColor): TColor; overload;
|
|
|
|
function GetManhattanDistancePointLine(X,Y, LineX1, LineY1, LineX2, LineY2: integer): integer;
|
|
function GetDistancePointLine(X,Y, LineX1, LineY1, LineX2, LineY2: integer): integer;
|
|
function GetDistancePointPoint(X1,Y1,X2,Y2: integer): integer;
|
|
|
|
// level graph
|
|
procedure LvlGraphMinimizeCrossings(Graph: TLvlGraph); overload;
|
|
procedure LvlGraphHighlightNode(Node: TLvlGraphNode;
|
|
HighlightedElements: TAvlTree; FollowIn, FollowOut: boolean);
|
|
function CompareLGNodesByCenterPos(Node1, Node2: Pointer): integer;
|
|
procedure DrawCurvedLvlLeftToRightEdge(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer; StraightenLeft, StraightenRight: Single);
|
|
function NodeAVLTreeToNodeArray(Nodes: TAvlTree; RemoveHidden: boolean; FreeTree: boolean): TLvlGraphNodeArray;
|
|
function NodeArrayAsString(Nodes: TLvlGraphNodeArray): String;
|
|
|
|
// debugging
|
|
function dbgs(p: TLvlGraphNodeCaptionPosition): string; overload;
|
|
function dbgs(o: TLvlGraphCtrlOption): string; overload;
|
|
function dbgs(Options: TLvlGraphCtrlOptions): string; overload;
|
|
|
|
implementation
|
|
|
|
type
|
|
TMinXGraph = class;
|
|
TMinXLevel = class;
|
|
TMinXPair = class;
|
|
|
|
{ TMinXNode }
|
|
|
|
TMinXNode = class
|
|
public
|
|
GraphNode: TLvlGraphNode;
|
|
InEdges, OutEdges: array of TMinXNode;
|
|
Level: TMinXLevel;
|
|
IndexInLevel: integer;
|
|
constructor Create(aNode: TLvlGraphNode);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TMinXLevel }
|
|
|
|
TMinXLevel = class
|
|
public
|
|
Index: integer;
|
|
Graph: TMinXGraph;
|
|
GraphLevel: TLvlGraphLevel;
|
|
Nodes: array of TMinXNode;
|
|
Pairs: array of TMinXPair;
|
|
BestNodes: TLvlGraphNodeArray;
|
|
constructor Create(aGraph: TMinXGraph; aIndex: integer);
|
|
destructor Destroy; override;
|
|
procedure GetCrossingCount(Node1, Node2: TMinXNode; out Crossing, SwitchCrossing: integer);
|
|
end;
|
|
|
|
{ TMinXPair }
|
|
|
|
TMinXPair = class
|
|
private
|
|
FSwitchDiff: integer; // change of crossings when the two nodes would switch
|
|
procedure SetSwitchDiff(AValue: integer);
|
|
public
|
|
Level: TMinXLevel;
|
|
Graph: TMinXGraph;
|
|
Index: integer;
|
|
PrevSameSwitchPair, NextSameSwitchPair: TMinXPair;
|
|
constructor Create(aLevel: TMinXLevel; aIndex: integer);
|
|
destructor Destroy; override;
|
|
procedure UnbindFromSwitchList;
|
|
function BindToSwitchList(AtEnd: Boolean=False): integer;
|
|
procedure ComputeCrossingCount(out Crossing, SwitchCrossing: integer);
|
|
function ComputeSwitchDiff: integer;
|
|
property SwitchDiff: integer read FSwitchDiff write SetSwitchDiff;
|
|
function AsString: string;
|
|
end;
|
|
|
|
{ TMinXGraph }
|
|
|
|
TMinXGraph = class
|
|
private
|
|
FGraphNodeToNode: TPointerToPointerTree; // TLvlGraphNode to TMinXNode
|
|
procedure UnbindPairs;
|
|
procedure BindPairs;
|
|
function ComputeCrossCount: integer;
|
|
procedure StoreAsBest(CheckIfBetter: boolean);
|
|
function ComputeLowestSwitchDiff(StartAtOld: boolean; IgnorePair: TMinXPair): integer;
|
|
public
|
|
Graph: TLvlGraph;
|
|
Levels: array of TMinXLevel;
|
|
Pairs: array of TMinXPair;
|
|
SameSwitchDiffPairs: array of TMinXPair; //
|
|
SameSwitchDiffPair0: integer;
|
|
LowestSwitchDiff: integer;
|
|
CrossCount: integer;
|
|
BestCrossCount: integer;
|
|
constructor Create(aGraph: TLvlGraph);
|
|
destructor Destroy; override;
|
|
procedure InitSearch;
|
|
function FindBestPair: TMinXPair;
|
|
procedure SwitchCrossingPairs(MaxRun: int64; var Run: int64);
|
|
procedure Shuffle;
|
|
procedure SwitchAndShuffle(MaxSingleRun, MaxTotalRun: int64);
|
|
procedure SwitchPair(Pair: TMinXPair);
|
|
procedure Apply; // reorder Graph nodes
|
|
function GraphNodeToNode(GraphNode: TLvlGraphNode): TMinXNode; inline;
|
|
procedure ConsistencyCheck;
|
|
end;
|
|
|
|
(** For MinimizeEdgeLens **)
|
|
TGraphEdgeLenMinimizerTree = class;
|
|
|
|
{ TGraphEdgeLenMinimizerNode }
|
|
|
|
TGraphEdgeLenMinimizerNode = class(TAVLTreeNode)
|
|
protected
|
|
FTree: TGraphEdgeLenMinimizerTree;
|
|
function GetLevel: Integer; virtual;
|
|
procedure SetLevel(AValue: Integer); virtual;
|
|
function GetInSibling(Index: Integer): TGraphEdgeLenMinimizerNode; virtual;
|
|
function GetOutSibling(Index: Integer): TGraphEdgeLenMinimizerNode; virtual;
|
|
function GetOutSiblingDistance(Index: Integer): Integer; virtual;
|
|
class function MapLevel(ALvl, {%H-}LvlCount: Integer): integer; virtual;
|
|
public
|
|
Node: TLvlGraphNode;
|
|
NextExtNodeTowardsLowerLevel: TGraphEdgeLenMinimizerNode;
|
|
MaxLevel, LevelDiff, VisitedId: Integer;
|
|
MinSubGraphLevel, MaxSubGraphLevel: Integer;
|
|
(* gelOnlyPush:
|
|
Nodes that have no shorten-able OutEdges.
|
|
Either no OutEdges at all, or all OutEdges are directly (len=1) connected
|
|
to another gelOnlyPush
|
|
Only move them, to make space for a moved none-gelOnlyPush node.
|
|
*)
|
|
Flags: set of (gelOnlyPush);
|
|
public
|
|
property Level: Integer read GetLevel write SetLevel;
|
|
function OutSiblingCount: Integer; virtual;
|
|
property OutSibling[Index: Integer]: TGraphEdgeLenMinimizerNode read GetOutSibling;
|
|
property OutSiblingDistance[Index: Integer]: Integer read GetOutSiblingDistance;
|
|
function InSiblingCount: Integer; virtual;
|
|
property InSibling[Index: Integer]: TGraphEdgeLenMinimizerNode read GetInSibling;
|
|
end;
|
|
|
|
TGraphEdgeLenMinimizerNodeClass = class of TGraphEdgeLenMinimizerNode;
|
|
|
|
{ TGraphEdgeLenMinimizerReverseNode }
|
|
|
|
TGraphEdgeLenMinimizerReverseNode = class(TGraphEdgeLenMinimizerNode)
|
|
protected
|
|
function GetLevel: Integer; override;
|
|
procedure SetLevel(AValue: Integer); override;
|
|
function GetInSibling(Index: Integer): TGraphEdgeLenMinimizerNode; override;
|
|
function GetOutSibling(Index: Integer): TGraphEdgeLenMinimizerNode; override;
|
|
function GetOutSiblingDistance(Index: Integer): Integer; override;
|
|
class function MapLevel(ALvl, LvlCount: Integer): integer; override;
|
|
public
|
|
function OutSiblingCount: Integer; override;
|
|
function InSiblingCount: Integer; override;
|
|
end;
|
|
|
|
{ TGraphEdgeLenMinimizerTree }
|
|
|
|
TGraphEdgeLenMinimizerTree = class(TAvlTree)
|
|
public
|
|
Graph: TLvlGraph;
|
|
ExtNodeWithHighestLevel, ExtNodeWithLowestLevel :TGraphEdgeLenMinimizerNode;
|
|
constructor Create;
|
|
function GetTreeNode(Node: TLvlGraphNode): TGraphEdgeLenMinimizerNode;
|
|
function AddGraphNode(Node: TLvlGraphNode): TGraphEdgeLenMinimizerNode;
|
|
function MapLevel(ALvl: Integer): integer;
|
|
end;
|
|
|
|
|
|
procedure LvlGraphMinimizeCrossings(Graph: TLvlGraph);
|
|
var
|
|
g: TMinXGraph;
|
|
begin
|
|
if (Graph.LevelCount<2) or (Graph.NodeCount<3) then exit;
|
|
g:=TMinXGraph.Create(Graph);
|
|
try
|
|
if length(g.Pairs)=0 then exit;
|
|
g.InitSearch;
|
|
{$IFDEF CheckMinXGraph}
|
|
debugln(['LvlGraphMinimizeCrossings Graph.NodeCount=',Graph.NodeCount]);
|
|
g.SwitchAndShuffle(100*Graph.NodeCount,
|
|
Min(10000,Graph.NodeCount*Graph.NodeCount));
|
|
{$ELSE}
|
|
g.SwitchAndShuffle(100*Graph.NodeCount,
|
|
Min(100000,Graph.NodeCount*Graph.NodeCount)
|
|
){%H-};
|
|
{$ENDIF}
|
|
g.Apply;
|
|
finally
|
|
g.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure LvlGraphHighlightNode(Node: TLvlGraphNode; HighlightedElements: TAvlTree;
|
|
FollowIn, FollowOut: boolean);
|
|
var
|
|
i: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
begin
|
|
if HighlightedElements.Find(Node)<>nil then exit;
|
|
HighlightedElements.Add(Node);
|
|
if FollowIn then
|
|
for i:=0 to Node.InEdgeCount-1 do begin
|
|
Edge:=Node.InEdges[i];
|
|
HighlightedElements.Add(Edge);
|
|
if not Edge.Source.Visible then
|
|
LvlGraphHighlightNode(Edge.Source,HighlightedElements,true,false);
|
|
end;
|
|
if FollowOut then
|
|
for i:=0 to Node.OutEdgeCount-1 do begin
|
|
Edge:=Node.OutEdges[i];
|
|
HighlightedElements.Add(Edge);
|
|
if not Edge.Target.Visible then
|
|
LvlGraphHighlightNode(Edge.Target,HighlightedElements,false,true);
|
|
end;
|
|
end;
|
|
|
|
function GetManhattanDistancePointLine(X, Y, LineX1, LineY1, LineX2, LineY2: integer
|
|
): integer;
|
|
// Manhattan distance
|
|
var
|
|
m: Integer;
|
|
begin
|
|
Result:=abs(X-LineX1)+abs(Y-LineY1);
|
|
Result:=Min(Result,abs(X-LineX2)+abs(Y-LineY2));
|
|
// from left to right
|
|
if abs(LineX2-LineX1)<abs(LineY2-LineY1) then begin
|
|
// vertical line
|
|
if (LineY1<LineY2) and ((Y<LineY1) or (Y>LineY2)) then exit;
|
|
if (LineY1>LineY2) and ((Y<LineY2) or (Y>LineY1)) then exit;
|
|
m:=((LineX2-LineX1)*(Y-LineY1)) div (LineY2-LineY1);
|
|
Result:=Min(Result,abs(X-m));
|
|
end else if LineX1<>LineX2 then begin
|
|
// horizontal line
|
|
if (LineX1<LineX2) and ((X<LineX1) or (X>LineX2)) then exit;
|
|
if (LineX1>LineX2) and ((X<LineX2) or (X>LineX1)) then exit;
|
|
m:=((LineY2-LineY1)*(X-LineX1)) div (LineX2-LineX1);
|
|
Result:=Min(Result,abs(Y-m));
|
|
end;
|
|
end;
|
|
|
|
function GetDistancePointLine(X, Y, LineX1, LineY1, LineX2, LineY2: integer
|
|
): integer;
|
|
var
|
|
lx, ly: single; // nearest point on line
|
|
lm, ln, pm, pn: single;
|
|
d: integer;
|
|
begin
|
|
//debugln(['GetDistancePointLine X=',X,',Y=',Y,' Line=',LineX1,',',LineY1,'..',LineX2,',',LineY2]);
|
|
Result:=GetDistancePointPoint(X,Y,LineX1,LineY1);
|
|
if Result<=1 then exit;
|
|
Result:=Min(Result,GetDistancePointPoint(X,Y,LineX2,LineY2));
|
|
if Result<=1 then exit;
|
|
if Abs(LineX1-LineX2)<=1 then begin
|
|
// vertical line
|
|
lx:=LineX1;
|
|
ly:=Y;
|
|
end else if Abs(LineY1-LineY2)<=1 then begin
|
|
lx:=X;
|
|
ly:=LineY1;
|
|
end else begin
|
|
lm:=single(LineY2-LineY1)/single(LineX2-LineX1);
|
|
ln:=single(LineY1)-single(LineX1)*lm;
|
|
pm:=single(-1)/lm;
|
|
pn:=single(Y)-single(X)*pm;
|
|
//debugln(['GetDistancePointLine lm=',lm,' ln=',ln,' pm=',pm,' pn=',pn]);
|
|
// ly = lx*lm+ln = lx*pm'+pn
|
|
// <=> lx*(lm-pm)=pn-ln
|
|
// <=> lx = (pn-ln) / (lm-pm)
|
|
lx:=(pn-ln)/(lm-pm);
|
|
ly:=single(lx)*lm+ln;
|
|
end;
|
|
//debugln(['GetDistancePointLine lx=',lx,', ly=',ly]);
|
|
|
|
// check if nearest point is on the line
|
|
if (LineX1<LineX2) and ((lx<LineX1) or (lx>LineX2)) then exit;
|
|
if (LineX1>LineX2) and ((lx>LineX1) or (lx<LineX2)) then exit;
|
|
d:=round(sqrt(sqr(single(X)-lx)+sqr(single(Y)-ly)));
|
|
Result:=Min(Result,d);
|
|
//debugln(['GetDistancePointLine lx=',lx,', ly=',ly,' Result=',Result]);
|
|
end;
|
|
|
|
function GetDistancePointPoint(X1, Y1, X2, Y2: integer): integer;
|
|
begin
|
|
Result:=round(sqrt(sqr(X2-X1)+sqr(Y1-Y2))+0.5);
|
|
end;
|
|
|
|
function GetCCPaletteRGB(Cnt: integer; Shuffled: boolean): TLazCtrlPalette;
|
|
type
|
|
TChannel = (cRed, cGreen, cBlue);
|
|
const
|
|
ChannelMax = alphaOpaque;
|
|
var
|
|
Steps, Step, Start, Value: array[TChannel] of integer;
|
|
|
|
function EnoughColors: boolean;
|
|
var
|
|
PotCnt: Integer;
|
|
ch: TChannel;
|
|
begin
|
|
PotCnt:=1;
|
|
for ch:=Low(TChannel) to High(TChannel) do
|
|
PotCnt*=Steps[ch];
|
|
Result:=PotCnt>=Cnt;
|
|
end;
|
|
|
|
var
|
|
ch: TChannel;
|
|
i: Integer;
|
|
begin
|
|
SetLength(Result,Cnt);
|
|
if Cnt=0 then exit;
|
|
for ch:=Low(TChannel) to High(TChannel) do
|
|
Steps[ch]:=1;
|
|
while not EnoughColors do
|
|
for ch:=Low(TChannel) to High(TChannel) do begin
|
|
if EnoughColors then break;
|
|
inc(Steps[ch]);
|
|
end;
|
|
for ch:=Low(TChannel) to High(TChannel) do begin
|
|
Step[ch]:=ChannelMax div Steps[ch];
|
|
Start[ch]:=ChannelMax-1-Step[ch]*(Steps[ch]-1);
|
|
Value[ch]:=Start[ch];
|
|
end;
|
|
for i:=0 to Cnt-1 do begin
|
|
Result[i].red:=Value[cRed];
|
|
Result[i].green:=Value[cGreen];
|
|
Result[i].blue:=Value[cBlue];
|
|
ch:=Low(TChannel);
|
|
repeat
|
|
Value[ch]+=Step[ch];
|
|
if (Value[ch]<ChannelMax) or (ch=High(TChannel)) then break;
|
|
Value[ch]:=Start[ch];
|
|
inc(ch);
|
|
until false;
|
|
end;
|
|
if Shuffled then
|
|
ShuffleCCPalette(Result);
|
|
end;
|
|
|
|
procedure ShuffleCCPalette(Palette: TLazCtrlPalette);
|
|
begin
|
|
|
|
end;
|
|
|
|
function Darker(const c: TColor): TColor;
|
|
var
|
|
r: Byte;
|
|
g: Byte;
|
|
b: Byte;
|
|
begin
|
|
RedGreenBlue(c,r,g,b);
|
|
r:=r div 2;
|
|
g:=g div 2;
|
|
b:=b div 2;
|
|
Result:=RGBToColor(r,g,b);
|
|
end;
|
|
|
|
function CompareLGNodesByCenterPos(Node1, Node2: Pointer): integer;
|
|
var
|
|
LNode1: TLvlGraphNode absolute Node1;
|
|
LNode2: TLvlGraphNode absolute Node2;
|
|
p1: Integer;
|
|
p2: Integer;
|
|
begin
|
|
p1:=LNode1.DrawCenter;
|
|
p2:=LNode2.DrawCenter;
|
|
if p1<p2 then
|
|
exit(-1)
|
|
else if p1>p2 then
|
|
exit(1);
|
|
// default compare by position in level
|
|
Result:=LNode1.IndexInLevel-LNode2.IndexInLevel;
|
|
end;
|
|
|
|
procedure DrawCurvedLvlLeftToRightEdge(Canvas: TFPCustomCanvas; x1, y1, x2,
|
|
y2: integer; StraightenLeft, StraightenRight: Single);
|
|
//var
|
|
// b: TBezier;
|
|
// Points: PPoint;
|
|
// Count: Longint;
|
|
// p: PPoint;
|
|
// i: Integer;
|
|
begin
|
|
Canvas.PolyBezier([
|
|
Point(x1,y1),
|
|
Point(x1+10,y1-Trunc(0.5+10*StraightenLeft)),
|
|
Point(x2-10,y2+Trunc(0.5+10*StraightenRight)),
|
|
Point(x2,y2)]);
|
|
exit;
|
|
//b:=Bezier(Point(x1,y1),Point(x1+10,y1),Point(x2-10,y2),Point(x2,y2));
|
|
//Points:=nil;
|
|
//Count:=0;
|
|
//Bezier2Polyline(b,Points,Count);
|
|
////debugln(['DrawCurvedLvlLeftToRightEdge Count=',Count]);
|
|
//if Count=0 then exit;
|
|
//p:=Points;
|
|
//Canvas.MoveTo(p^);
|
|
////debugln(['DrawCurvedLvlLeftToRightEdge Point0=',dbgs(p^)]);
|
|
//for i:=1 to Count-1 do begin
|
|
// inc(p);
|
|
// //debugln(['DrawCurvedLvlLeftToRightEdge Point',i,'=',dbgs(p^)]);
|
|
// Canvas.LineTo(p^);
|
|
//end;
|
|
//Freemem(Points);
|
|
end;
|
|
|
|
function NodeAVLTreeToNodeArray(Nodes: TAvlTree; RemoveHidden: boolean;
|
|
FreeTree: boolean): TLvlGraphNodeArray;
|
|
var
|
|
AVLNode: TAvlTreeNode;
|
|
Node: TLvlGraphNode;
|
|
i: Integer;
|
|
begin
|
|
if Nodes=nil then begin
|
|
SetLength(Result,0);
|
|
exit;
|
|
end;
|
|
AVLNode:=Nodes.FindLowest;
|
|
i:=0;
|
|
SetLength(Result,Nodes.Count);
|
|
while AVLNode<>nil do begin
|
|
Node:=TLvlGraphNode(AVLNode.Data);
|
|
if Node.Visible or (not RemoveHidden) then begin
|
|
Result[i]:=Node;
|
|
inc(i);
|
|
end;
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
SetLength(Result,i);
|
|
if FreeTree then
|
|
Nodes.Free;
|
|
end;
|
|
|
|
function NodeArrayAsString(Nodes: TLvlGraphNodeArray): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:='';
|
|
for i:=0 to Length(Nodes)-1 do begin
|
|
if i>0 then
|
|
Result+=', ';
|
|
Result+=Nodes[i].Caption;
|
|
end;
|
|
end;
|
|
|
|
function dbgs(p: TLvlGraphNodeCaptionPosition): string;
|
|
begin
|
|
Result:=GetEnumName(typeinfo(p),ord(p));
|
|
end;
|
|
|
|
function dbgs(o: TLvlGraphCtrlOption): string;
|
|
begin
|
|
Result:=GetEnumName(typeinfo(o),ord(o));
|
|
end;
|
|
|
|
function dbgs(Options: TLvlGraphCtrlOptions): string;
|
|
var
|
|
o: TLvlGraphCtrlOption;
|
|
begin
|
|
Result:='';
|
|
for o:=Low(TLvlGraphCtrlOption) to high(TLvlGraphCtrlOption) do
|
|
if o in Options then begin
|
|
if Result<>'' then Result+=',';
|
|
Result+=dbgs(o);
|
|
end;
|
|
Result:='['+Result+']';
|
|
end;
|
|
|
|
{ TLvlGraphSubGraph }
|
|
|
|
constructor TLvlGraphSubGraph.Create(TheGraph: TLvlGraph; TheIndex: integer);
|
|
begin
|
|
inherited Create;
|
|
FGraph := TheGraph;
|
|
FIndex := TheIndex;
|
|
FGraph.fSubGraphs.Insert(TheIndex, Self);
|
|
end;
|
|
|
|
destructor TLvlGraphSubGraph.Destroy;
|
|
begin
|
|
FGraph.fSubGraphs.Remove(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TGraphEdgeLenMinimizerTree }
|
|
|
|
function CompareEdgeLenMinimizerNodes(Node1, Node2: Pointer): integer;
|
|
begin
|
|
Result:=ComparePointer(Node1,Node2);
|
|
end;
|
|
|
|
function CompareLGNodeWithEdgeLenMinimizerNode(GNode, ANode: Pointer): integer;
|
|
begin
|
|
Result:=ComparePointer(GNode,ANode);
|
|
end;
|
|
|
|
{ TLvlGraphLimits }
|
|
|
|
procedure TLvlGraphLimits.SetMaxLevelHeightAbs(AValue: integer);
|
|
begin
|
|
if FMaxLevelHeightAbs = AValue then Exit;
|
|
FMaxLevelHeightAbs := AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphLimits.SetMaxLevelHeightRel(AValue: single);
|
|
begin
|
|
if FMaxLevelHeightRel = AValue then Exit;
|
|
FMaxLevelHeightRel := AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
constructor TLvlGraphLimits.Create(AControl: TCustomLvlGraphControl);
|
|
begin
|
|
FControl:=AControl;
|
|
FMaxLevelHeightAbs := DefaultMaxLevelHeightAbs;
|
|
FMaxLevelHeightRel := DefaultMaxLevelHeightRel;
|
|
end;
|
|
|
|
destructor TLvlGraphLimits.Destroy;
|
|
begin
|
|
FControl.FLimits:=nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLvlGraphLimits.Assign(Source: TPersistent);
|
|
var
|
|
Src: TLvlGraphLimits;
|
|
begin
|
|
if Source is TLvlGraphLimits then begin
|
|
Src:=TLvlGraphLimits(Source);
|
|
MaxLevelHeightAbs := Src.MaxLevelHeightAbs;
|
|
MaxLevelHeightRel := Src.MaxLevelHeightRel;
|
|
end;
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TLvlGraphLimits.Equals(Obj: TObject): boolean;
|
|
var
|
|
Src: TLvlGraphLimits;
|
|
begin
|
|
Result:=inherited Equals(Obj);
|
|
if not Result then exit;
|
|
if Obj is TLvlGraphLimits then begin
|
|
Src:=TLvlGraphLimits(Obj);
|
|
Result:=(MaxLevelHeightAbs=Src.MaxLevelHeightAbs)
|
|
and (MaxLevelHeightRel=Src.MaxLevelHeightRel);
|
|
end;
|
|
end;
|
|
|
|
constructor TGraphEdgeLenMinimizerTree.Create;
|
|
begin
|
|
inherited Create(@CompareEdgeLenMinimizerNodes);
|
|
NodeClass := TGraphEdgeLenMinimizerNode;
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerTree.GetTreeNode(Node: TLvlGraphNode): TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Result:=TGraphEdgeLenMinimizerNode(FindKey(Pointer(Node),@CompareLGNodeWithEdgeLenMinimizerNode));
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerTree.AddGraphNode(Node: TLvlGraphNode
|
|
): TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Result:=TGraphEdgeLenMinimizerNode(NodeClass.Create);
|
|
Result.FTree := Self;
|
|
Result.Node:=Node;
|
|
Result.Data:=Node;
|
|
if ExtNodeWithHighestLevel = nil then
|
|
ExtNodeWithHighestLevel := Result
|
|
else
|
|
ExtNodeWithLowestLevel.NextExtNodeTowardsLowerLevel := Result;
|
|
ExtNodeWithLowestLevel := Result;
|
|
Add(Result);
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerTree.MapLevel(ALvl: Integer): integer;
|
|
begin
|
|
Result := TGraphEdgeLenMinimizerNodeClass(NodeClass).MapLevel(ALvl, Graph.LevelCount);
|
|
end;
|
|
|
|
{ TGraphEdgeLenMinimizerNode }
|
|
|
|
function TGraphEdgeLenMinimizerNode.GetLevel: Integer;
|
|
begin
|
|
Result := Node.Level.Index;
|
|
end;
|
|
|
|
procedure TGraphEdgeLenMinimizerNode.SetLevel(AValue: Integer);
|
|
begin
|
|
Node.Level := FTree.Graph.Levels[AValue];
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerNode.GetInSibling(Index: Integer
|
|
): TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Result := FTree.GetTreeNode(Node.InEdges[Index].Source);
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerNode.GetOutSiblingDistance(Index: Integer
|
|
): Integer;
|
|
begin
|
|
Result := Node.OutEdges[Index].Target.Level.Index - Node.Level.Index;
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerNode.GetOutSibling(Index: Integer
|
|
): TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Result := FTree.GetTreeNode(Node.OutEdges[Index].Target);
|
|
end;
|
|
|
|
class function TGraphEdgeLenMinimizerNode.MapLevel(ALvl, LvlCount: Integer
|
|
): integer;
|
|
begin
|
|
Result := ALvl;
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerNode.OutSiblingCount: Integer;
|
|
begin
|
|
Result := Node.OutEdgeCount;
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerNode.InSiblingCount: Integer;
|
|
begin
|
|
Result := Node.InEdgeCount;
|
|
end;
|
|
|
|
{ TGraphEdgeLenMinimizerReverseNode }
|
|
|
|
function TGraphEdgeLenMinimizerReverseNode.GetInSibling(Index: Integer
|
|
): TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Result := FTree.GetTreeNode(Node.OutEdges[Index].Target);
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerReverseNode.GetOutSibling(Index: Integer
|
|
): TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Result := FTree.GetTreeNode(Node.InEdges[Index].Source);
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerReverseNode.GetOutSiblingDistance(Index: Integer
|
|
): Integer;
|
|
begin
|
|
Result := Node.Level.Index - Node.InEdges[Index].Source.Level.Index;
|
|
end;
|
|
|
|
class function TGraphEdgeLenMinimizerReverseNode.MapLevel(ALvl,
|
|
LvlCount: Integer): integer;
|
|
begin
|
|
Result := LvlCount - 1 - ALvl;
|
|
end;
|
|
|
|
procedure TGraphEdgeLenMinimizerReverseNode.SetLevel(AValue: Integer);
|
|
begin
|
|
Node.Level := FTree.Graph.Levels[MinSubGraphLevel + MaxSubGraphLevel - AValue];
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerReverseNode.GetLevel: Integer;
|
|
begin
|
|
Result := MinSubGraphLevel + MaxSubGraphLevel - Node.Level.Index;
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerReverseNode.OutSiblingCount: Integer;
|
|
begin
|
|
Result := Node.InEdgeCount;
|
|
end;
|
|
|
|
function TGraphEdgeLenMinimizerReverseNode.InSiblingCount: Integer;
|
|
begin
|
|
Result := Node.OutEdgeCount;
|
|
end;
|
|
|
|
{ TLvlGraphEdgeStyle }
|
|
|
|
procedure TLvlGraphEdgeStyle.SetMouseDistMax(AValue: integer);
|
|
begin
|
|
if FMouseDistMax=AValue then Exit;
|
|
FMouseDistMax:=AValue;
|
|
end;
|
|
|
|
procedure TLvlGraphEdgeStyle.SetBackColor(AValue: TColor);
|
|
begin
|
|
if FBackColor=AValue then Exit;
|
|
FBackColor:=AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphEdgeStyle.SetColor(AValue: TColor);
|
|
begin
|
|
if FColor=AValue then Exit;
|
|
FColor:=AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphEdgeStyle.SetBackHighlightColor(AValue: TColor);
|
|
begin
|
|
if FBackHighlightColor=AValue then Exit;
|
|
FBackHighlightColor:=AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphEdgeStyle.SetHighlightColor(AValue: TColor);
|
|
begin
|
|
if FHighlightColor=AValue then Exit;
|
|
FHighlightColor:=AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphEdgeStyle.SetShape(AValue: TLvlGraphEdgeShape);
|
|
begin
|
|
if FShape=AValue then Exit;
|
|
FShape:=AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphEdgeStyle.SetSplitMode(AValue: TLvlGraphEdgeSplitMode);
|
|
begin
|
|
if FSplitMode=AValue then Exit;
|
|
FSplitMode:=AValue;
|
|
Control.InvalidateAutoLayout;
|
|
end;
|
|
|
|
constructor TLvlGraphEdgeStyle.Create(AControl: TCustomLvlGraphControl);
|
|
begin
|
|
FControl:=AControl;
|
|
FMouseDistMax:=DefaultLvlGraphEdgeNearMouseDistMax;
|
|
FSplitMode:=DefaultLvlGraphEdgeSplitMode;
|
|
FShape:=DefaultLvlGraphEdgeShape;
|
|
FColor:=DefaultLvlGraphEdgeColor;
|
|
FHighlightColor:=DefaultLvlGraphEdgeHighlightColor;
|
|
FBackColor:=DefaultLvlGraphEdgeBackColor;
|
|
FBackHighlightColor:=DefaultLvlGraphEdgeBackHighlightColor;
|
|
end;
|
|
|
|
destructor TLvlGraphEdgeStyle.Destroy;
|
|
begin
|
|
FControl.FEdgeStyle:=nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLvlGraphEdgeStyle.Assign(Source: TPersistent);
|
|
var
|
|
Src: TLvlGraphEdgeStyle;
|
|
begin
|
|
if Source is TLvlGraphEdgeStyle then begin
|
|
Src:=TLvlGraphEdgeStyle(Source);
|
|
MouseDistMax:=Src.MouseDistMax;
|
|
SplitMode:=Src.SplitMode;
|
|
Shape:=Src.Shape;
|
|
Color:=Src.Color;
|
|
HighlightColor:=Src.HighlightColor;
|
|
BackColor:=Src.BackColor;
|
|
BackHighlightColor:=Src.BackHighlightColor;
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TLvlGraphEdgeStyle.Equals(Obj: TObject): boolean;
|
|
var
|
|
Src: TLvlGraphEdgeStyle;
|
|
begin
|
|
Result:=inherited Equals(Obj);
|
|
if not Result then exit;
|
|
if Obj is TLvlGraphEdgeStyle then begin
|
|
Src:=TLvlGraphEdgeStyle(Obj);
|
|
Result:=(SplitMode=Src.SplitMode)
|
|
and (MouseDistMax=Src.MouseDistMax)
|
|
and (Shape=Src.Shape)
|
|
and (Color=Src.Color)
|
|
and (HighlightColor=Src.HighlightColor)
|
|
and (BackColor=Src.BackColor)
|
|
and (BackHighlightColor=Src.BackHighlightColor);
|
|
end;
|
|
end;
|
|
|
|
{ TMinXPair }
|
|
|
|
procedure TMinXPair.SetSwitchDiff(AValue: integer);
|
|
begin
|
|
if FSwitchDiff=AValue then Exit;
|
|
UnbindFromSwitchList;
|
|
FSwitchDiff:=AValue;
|
|
BindToSwitchList;
|
|
end;
|
|
|
|
constructor TMinXPair.Create(aLevel: TMinXLevel; aIndex: integer);
|
|
begin
|
|
Level:=aLevel;
|
|
Graph:=Level.Graph;
|
|
Index:=aIndex;
|
|
end;
|
|
|
|
destructor TMinXPair.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TMinXPair.UnbindFromSwitchList;
|
|
begin
|
|
if PrevSameSwitchPair<>nil then
|
|
PrevSameSwitchPair.NextSameSwitchPair:=NextSameSwitchPair
|
|
else if Graph.SameSwitchDiffPairs[Graph.SameSwitchDiffPair0+SwitchDiff]=Self
|
|
then begin
|
|
Graph.SameSwitchDiffPairs[Graph.SameSwitchDiffPair0+SwitchDiff]:=NextSameSwitchPair;
|
|
if (NextSameSwitchPair=nil) and (Graph.LowestSwitchDiff=SwitchDiff) then
|
|
Graph.LowestSwitchDiff:=Graph.ComputeLowestSwitchDiff(true,Self);
|
|
end;
|
|
if NextSameSwitchPair<>nil then
|
|
NextSameSwitchPair.PrevSameSwitchPair:=PrevSameSwitchPair;
|
|
PrevSameSwitchPair:=nil;
|
|
NextSameSwitchPair:=nil;
|
|
end;
|
|
|
|
function TMinXPair.BindToSwitchList(AtEnd: Boolean): integer;
|
|
var
|
|
n: TMinXPair;
|
|
begin
|
|
Result := 0;
|
|
n:=Graph.SameSwitchDiffPairs[Graph.SameSwitchDiffPair0+SwitchDiff];
|
|
if AtEnd and (n<> nil) then begin
|
|
while n.NextSameSwitchPair <> nil do begin
|
|
n:=n.NextSameSwitchPair;
|
|
inc(Result);
|
|
end;
|
|
n.NextSameSwitchPair:=Self;
|
|
PrevSameSwitchPair:=n;
|
|
exit;
|
|
end;
|
|
NextSameSwitchPair:=n;
|
|
Graph.SameSwitchDiffPairs[Graph.SameSwitchDiffPair0+SwitchDiff]:=Self;
|
|
if NextSameSwitchPair<>nil then
|
|
NextSameSwitchPair.PrevSameSwitchPair:=Self;
|
|
if (Graph.LowestSwitchDiff+Graph.SameSwitchDiffPair0<0)
|
|
or (Graph.LowestSwitchDiff>SwitchDiff) then
|
|
Graph.LowestSwitchDiff:=SwitchDiff;
|
|
end;
|
|
|
|
procedure TMinXPair.ComputeCrossingCount(out Crossing,
|
|
SwitchCrossing: integer);
|
|
begin
|
|
Level.GetCrossingCount(Level.Nodes[Index],Level.Nodes[Index+1],
|
|
Crossing,SwitchCrossing);
|
|
end;
|
|
|
|
function TMinXPair.ComputeSwitchDiff: integer;
|
|
var
|
|
Crossing, SwitchCrossing: integer;
|
|
begin
|
|
Level.GetCrossingCount(Level.Nodes[Index],Level.Nodes[Index+1],
|
|
Crossing,SwitchCrossing);
|
|
Result:=SwitchCrossing-Crossing;
|
|
end;
|
|
|
|
function TMinXPair.AsString: string;
|
|
begin
|
|
Result:='[lvl='+dbgs(Level.Index)
|
|
+',A='+dbgs(Index)+':'+Level.Nodes[Index].GraphNode.Caption
|
|
+',B='+dbgs(Index+1)+':'+Level.Nodes[Index+1].GraphNode.Caption
|
|
+',Switch='+dbgs(SwitchDiff)
|
|
+']';
|
|
end;
|
|
|
|
{ TMinXGraph }
|
|
|
|
constructor TMinXGraph.Create(aGraph: TLvlGraph);
|
|
var
|
|
GraphNode: TLvlGraphNode;
|
|
i: Integer;
|
|
Level: TMinXLevel;
|
|
n: Integer;
|
|
e: Integer;
|
|
Node: TMinXNode;
|
|
Cnt: Integer;
|
|
OtherNode: TMinXNode;
|
|
begin
|
|
Graph:=aGraph;
|
|
|
|
// create nodes
|
|
FGraphNodeToNode:=TPointerToPointerTree.Create;
|
|
for i:=0 to Graph.NodeCount-1 do begin
|
|
GraphNode:=Graph.Nodes[i];
|
|
Node:=TMinXNode.Create(GraphNode);
|
|
FGraphNodeToNode[GraphNode]:=Node;
|
|
end;
|
|
|
|
// create levels
|
|
SetLength(Levels,aGraph.LevelCount);
|
|
for i:=0 to length(Levels)-1 do
|
|
Levels[i]:=TMinXLevel.Create(Self,i);
|
|
|
|
// create OutEdges arrays
|
|
for i:=0 to length(Levels)-2 do begin
|
|
Level:=Levels[i];
|
|
for n:=0 to length(Level.Nodes)-1 do begin
|
|
Node:=Level.Nodes[n];
|
|
GraphNode:=Node.GraphNode;
|
|
SetLength(Node.OutEdges,GraphNode.OutEdgeCount);
|
|
Cnt:=0;
|
|
for e:=0 to GraphNode.OutEdgeCount-1 do begin
|
|
OtherNode:=GraphNodeToNode(GraphNode.OutEdges[e].Target);
|
|
if Node.Level.Index+1<>OtherNode.Level.Index then continue;
|
|
Node.OutEdges[Cnt]:=OtherNode;
|
|
Cnt+=1;
|
|
end;
|
|
SetLength(Node.OutEdges,Cnt);
|
|
end;
|
|
end;
|
|
|
|
// create InEdges arrays
|
|
for i:=1 to length(Levels)-1 do begin
|
|
Level:=Levels[i];
|
|
for n:=0 to length(Level.Nodes)-1 do begin
|
|
Node:=Level.Nodes[n];
|
|
GraphNode:=Node.GraphNode;
|
|
SetLength(Node.InEdges,GraphNode.InEdgeCount);
|
|
Cnt:=0;
|
|
for e:=0 to GraphNode.InEdgeCount-1 do begin
|
|
OtherNode:=GraphNodeToNode(GraphNode.InEdges[e].Source);
|
|
if Node.Level.Index-1<>OtherNode.Level.Index then continue;
|
|
Node.InEdges[Cnt]:=OtherNode;
|
|
Cnt+=1;
|
|
end;
|
|
SetLength(Node.InEdges,Cnt);
|
|
end;
|
|
end;
|
|
|
|
BindPairs;
|
|
|
|
{$IFDEF CheckMinXGraph}
|
|
ConsistencyCheck;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TMinXGraph.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to length(Levels)-1 do
|
|
Levels[i].Free;
|
|
SetLength(Levels,0);
|
|
for i:=0 to length(Pairs)-1 do
|
|
Pairs[i].Free;
|
|
SetLength(Pairs,0);
|
|
SetLength(SameSwitchDiffPairs,0);
|
|
FreeAndNil(FGraphNodeToNode);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TMinXGraph.UnbindPairs;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to length(Pairs)-1 do
|
|
Pairs[i].UnbindFromSwitchList;
|
|
end;
|
|
|
|
procedure TMinXGraph.BindPairs;
|
|
var
|
|
Cnt: Integer;
|
|
i: Integer;
|
|
Level: TMinXLevel;
|
|
n: Integer;
|
|
Pair: TMinXPair;
|
|
First: Boolean;
|
|
begin
|
|
First:=length(Pairs)=0;
|
|
if First then begin
|
|
Cnt:=0;
|
|
for i:=0 to length(Levels)-1 do
|
|
Cnt+=Max(0,length(Levels[i].Nodes)-1);
|
|
SetLength(Pairs,Cnt);
|
|
end;
|
|
Cnt:=0;
|
|
for i:=0 to length(Levels)-1 do begin
|
|
Level:=Levels[i];
|
|
if length(Level.Nodes) > 0 then
|
|
SetLength(Level.Pairs,length(Level.Nodes)-1);
|
|
for n:=0 to length(Level.Pairs)-1 do begin
|
|
if First then begin
|
|
Pair:=TMinXPair.Create(Level,n);
|
|
Pairs[Cnt]:=Pair;
|
|
Level.Pairs[n]:=Pair;
|
|
end else
|
|
Pair:=Pairs[Cnt];
|
|
Pair.FSwitchDiff:=Pair.ComputeSwitchDiff;
|
|
Cnt+=1;
|
|
end;
|
|
end;
|
|
if First then begin
|
|
SameSwitchDiffPair0:=Graph.NodeCount*Graph.NodeCount;
|
|
LowestSwitchDiff:=-SameSwitchDiffPair0-1;
|
|
SetLength(SameSwitchDiffPairs,2*SameSwitchDiffPair0+1);
|
|
end;
|
|
for i:=0 to length(Pairs)-1 do
|
|
Pairs[i].BindToSwitchList;
|
|
CrossCount:=ComputeCrossCount;
|
|
end;
|
|
|
|
function TMinXGraph.ComputeCrossCount: integer;
|
|
var
|
|
l: Integer;
|
|
Level: TMinXLevel;
|
|
i: Integer;
|
|
Node1: TMinXNode;
|
|
j: Integer;
|
|
Node2: TMinXNode;
|
|
e1: Integer;
|
|
Target1: TMinXNode;
|
|
e2: Integer;
|
|
Target2: TMinXNode;
|
|
begin
|
|
Result:=0;
|
|
for l:=0 to length(Levels)-2 do begin
|
|
Level:=Levels[l];
|
|
for i:=0 to length(Level.Nodes)-2 do begin
|
|
Node1:=Level.Nodes[i];
|
|
for j:=i+1 to length(Level.Nodes)-1 do begin
|
|
Node2:=Level.Nodes[j];
|
|
for e1:=0 to length(Node1.OutEdges)-1 do begin
|
|
Target1:=Node1.OutEdges[e1];
|
|
for e2:=0 to length(Node2.OutEdges)-1 do begin
|
|
Target2:=Node2.OutEdges[e2];
|
|
if Target1.IndexInLevel>Target2.IndexInLevel then
|
|
Result+=1;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMinXGraph.InitSearch;
|
|
begin
|
|
StoreAsBest(false);
|
|
end;
|
|
|
|
procedure TMinXGraph.StoreAsBest(CheckIfBetter: boolean);
|
|
var
|
|
l: Integer;
|
|
Level: TMinXLevel;
|
|
n: Integer;
|
|
begin
|
|
if CheckIfBetter and (BestCrossCount>=0) and (BestCrossCount<CrossCount) then
|
|
exit;
|
|
BestCrossCount:=CrossCount;
|
|
for l:=0 to length(Levels)-1 do begin
|
|
Level:=Levels[l];
|
|
for n:=0 to length(Level.Nodes)-1 do
|
|
Level.BestNodes[n]:=Level.Nodes[n].GraphNode;
|
|
end;
|
|
end;
|
|
|
|
function TMinXGraph.ComputeLowestSwitchDiff(StartAtOld: boolean;
|
|
IgnorePair: TMinXPair): integer;
|
|
var
|
|
i: Integer;
|
|
Pair: TMinXPair;
|
|
begin
|
|
if StartAtOld then begin
|
|
for i:=LowestSwitchDiff to Graph.NodeCount-1 do begin
|
|
if SameSwitchDiffPairs[i+SameSwitchDiffPair0]<>nil then
|
|
exit(i);
|
|
end;
|
|
end;
|
|
Result:=SameSwitchDiffPair0+1;
|
|
for i:=0 to length(Pairs)-1 do begin
|
|
Pair:=Pairs[i];
|
|
if IgnorePair=Pair then continue;
|
|
Result:=Min(Result,Pairs[i].SwitchDiff);
|
|
end;
|
|
if Result>SameSwitchDiffPair0 then
|
|
Result:=-1-SameSwitchDiffPair0;
|
|
end;
|
|
|
|
function TMinXGraph.FindBestPair: TMinXPair;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=LowestSwitchDiff+SameSwitchDiffPair0;
|
|
if i>=0 then
|
|
Result:=SameSwitchDiffPairs[i]
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
procedure TMinXGraph.SwitchCrossingPairs(MaxRun: int64; var Run: int64);
|
|
(* Calculating how many rounds to go for ZeroRun
|
|
Switching a node with SwitchDiff=0, can move other zero-nodes (i.e.,
|
|
remove them in one place, and create another in a new place)
|
|
Extra loops are needed to:
|
|
- run such new nodes
|
|
- re-run and switch back the original nodes, to test the zero-nodes
|
|
that were removed.
|
|
Sucessful swaps (unblocking actual crossings) can be found even at
|
|
high multiplies of LastInsertIdx (the count of zero-nodes)
|
|
*)
|
|
var
|
|
Pair: TMinXPair;
|
|
LastInsertIdx, ZeroRun: Integer;
|
|
begin
|
|
ZeroRun := 0;
|
|
while (MaxRun>0) and (BestCrossCount<>0) do begin
|
|
//debugln(['TMinXGraph.SwitchCrossingPairs ',MaxRun,' ',Run]);
|
|
Pair:=FindBestPair;
|
|
Run+=1;
|
|
if (Pair=nil) then exit;
|
|
if (Pair.SwitchDiff=0) then begin
|
|
dec(ZeroRun);
|
|
if ZeroRun = 0 then
|
|
exit;
|
|
end
|
|
else
|
|
ZeroRun := 0;
|
|
SwitchPair(Pair);
|
|
if (Pair.SwitchDiff=0) then begin
|
|
Pair.UnbindFromSwitchList;
|
|
LastInsertIdx := Pair.BindToSwitchList(True);
|
|
If ZeroRun = -1 then
|
|
if CrossCount < BestCrossCount + BestCrossCount div 8 then // add 12% to BestCrossCount
|
|
ZeroRun := 8 * LastInsertIdx+1 // closer to a new BestCrossCount, search harder
|
|
else
|
|
ZeroRun := 2 * LastInsertIdx+1;
|
|
end;
|
|
MaxRun-=1;
|
|
end;
|
|
end;
|
|
|
|
procedure TMinXGraph.Shuffle;
|
|
var
|
|
l: Integer;
|
|
Level: TMinXLevel;
|
|
n1: Integer;
|
|
n2: Integer;
|
|
Node: TMinXNode;
|
|
begin
|
|
{$IFDEF CheckMinXGraph}
|
|
ConsistencyCheck;
|
|
{$ENDIF}
|
|
UnbindPairs;
|
|
for l:=0 to length(Levels)-1 do begin
|
|
Level:=Levels[l];
|
|
for n1:=0 to length(Level.Nodes)-1 do begin
|
|
n2:=Random(length(Level.Nodes));
|
|
if n1=n2 then continue;
|
|
Node:=Level.Nodes[n1];
|
|
Level.Nodes[n1]:=Level.Nodes[n2];
|
|
Level.Nodes[n2]:=Node;
|
|
Level.Nodes[n1].IndexInLevel:=n1;
|
|
Level.Nodes[n2].IndexInLevel:=n2;
|
|
end;
|
|
end;
|
|
BindPairs;
|
|
StoreAsBest(true);
|
|
{$IFDEF CheckMinXGraph}
|
|
ConsistencyCheck;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TMinXGraph.SwitchAndShuffle(MaxSingleRun, MaxTotalRun: int64);
|
|
var
|
|
Run: int64;
|
|
begin
|
|
Run:=1;
|
|
while BestCrossCount<>0 do begin
|
|
SwitchCrossingPairs(MaxSingleRun,Run);
|
|
if Run>MaxTotalRun then exit;
|
|
Shuffle;
|
|
end;
|
|
end;
|
|
|
|
procedure TMinXGraph.SwitchPair(Pair: TMinXPair);
|
|
|
|
procedure UpdateSwitchDiff(TargetOfNode1, TargetOfNode2: TMinXNode);
|
|
var
|
|
TargetPair: TMinXPair;
|
|
begin
|
|
if TargetOfNode1.IndexInLevel+1=TargetOfNode2.IndexInLevel then begin
|
|
TargetPair:=TargetOfNode1.Level.Pairs[TargetOfNode1.IndexInLevel];
|
|
// no longer crossing, switching TargetPair would create the cross again, from -1 to +1 = +2
|
|
TargetPair.SwitchDiff:=TargetPair.SwitchDiff+2;
|
|
end else if TargetOfNode1.IndexInLevel-1=TargetOfNode2.IndexInLevel then begin
|
|
TargetPair:=TargetOfNode2.Level.Pairs[TargetOfNode2.IndexInLevel];
|
|
// now crossing, switching TargetPair would solve the cross again, from +1 to -1 = -2
|
|
TargetPair.SwitchDiff:=TargetPair.SwitchDiff-2;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Node1, Node2: TMinXNode;
|
|
i: Integer;
|
|
j: Integer;
|
|
NeighbourPair: TMinXPair;
|
|
Level: TMinXLevel;
|
|
begin
|
|
//debugln(['TMinXGraph.SwitchPair ',Pair.AsString]);
|
|
{$IFDEF CheckMinXGraph}
|
|
ConsistencyCheck;
|
|
{$ENDIF}
|
|
|
|
Level:=Pair.Level;
|
|
|
|
// switch nodes
|
|
Node1:=Level.Nodes[Pair.Index];
|
|
Node2:=Level.Nodes[Pair.Index+1];
|
|
Level.Nodes[Pair.Index]:=Node2;
|
|
Level.Nodes[Pair.Index+1]:=Node1;
|
|
Node1:=Level.Nodes[Pair.Index];
|
|
Node2:=Level.Nodes[Pair.Index+1];
|
|
Node1.IndexInLevel:=Pair.Index;
|
|
Node2.IndexInLevel:=Pair.Index+1;
|
|
|
|
// reverse Pair.SwitchDiff
|
|
CrossCount+=Pair.SwitchDiff;
|
|
Pair.SwitchDiff:=-Pair.SwitchDiff;
|
|
//debugln(['TMinXGraph.SwitchPair Pair.SwitchDiff should be equal: ',Pair.SwitchDiff,' = ',Pair.ComputeSwitchDiff]);
|
|
|
|
// compute SwitchDiff of new neighbour pairs
|
|
if Pair.Index>0 then begin
|
|
NeighbourPair:=Level.Pairs[Pair.Index-1];
|
|
NeighbourPair.SwitchDiff:=NeighbourPair.ComputeSwitchDiff;
|
|
end;
|
|
if Pair.Index+1<length(Level.Pairs) then begin
|
|
NeighbourPair:=Level.Pairs[Pair.Index+1];
|
|
NeighbourPair.SwitchDiff:=NeighbourPair.ComputeSwitchDiff;
|
|
end;
|
|
|
|
// update SwitchDiff of all connected nodes
|
|
for i:=0 to length(Node1.OutEdges)-1 do
|
|
for j:=0 to length(Node2.OutEdges)-1 do
|
|
UpdateSwitchDiff(Node1.OutEdges[i],Node2.OutEdges[j]);
|
|
for i:=0 to length(Node1.InEdges)-1 do
|
|
for j:=0 to length(Node2.InEdges)-1 do
|
|
UpdateSwitchDiff(Node1.InEdges[i],Node2.InEdges[j]);
|
|
|
|
StoreAsBest(true);
|
|
|
|
{$IFDEF CheckMinXGraph}
|
|
ConsistencyCheck;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TMinXGraph.Apply;
|
|
var
|
|
i: Integer;
|
|
Level: TMinXLevel;
|
|
j: Integer;
|
|
begin
|
|
for i:=0 to length(Levels)-1 do begin
|
|
Level:=Levels[i];
|
|
for j:=0 to length(Level.BestNodes)-1 do
|
|
Level.BestNodes[j].IndexInLevel:=j;
|
|
end;
|
|
end;
|
|
|
|
function TMinXGraph.GraphNodeToNode(GraphNode: TLvlGraphNode): TMinXNode;
|
|
begin
|
|
Result:=TMinXNode(FGraphNodeToNode[GraphNode]);
|
|
end;
|
|
|
|
procedure TMinXGraph.ConsistencyCheck;
|
|
|
|
procedure Err(Msg: string = '');
|
|
begin
|
|
raise Exception.Create('TMinXGraph.ConsistencyCheck: '+Msg);
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
Pair: TMinXPair;
|
|
Level: TMinXLevel;
|
|
j: Integer;
|
|
Node: TMinXNode;
|
|
e: Integer;
|
|
OtherNode: TMinXNode;
|
|
k: Integer;
|
|
AVLNode: TAvlTreeNode;
|
|
P2PItem: PPointerToPointerItem;
|
|
begin
|
|
AVLNode:=FGraphNodeToNode.Tree.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
P2PItem:=PPointerToPointerItem(AVLNode.Data);
|
|
if not (TObject(P2PItem^.Key) is TLvlGraphNode) then
|
|
Err(DbgSName(TObject(P2PItem^.Key)));
|
|
if not (TObject(P2PItem^.Value) is TMinXNode) then
|
|
Err(DbgSName(TObject(P2PItem^.Value)));
|
|
if TMinXNode(P2PItem^.Value).GraphNode=nil then
|
|
Err(dbgs(TMinXNode(P2PItem^.Value).IndexInLevel));
|
|
if TLvlGraphNode(P2PItem^.Key)<>TMinXNode(P2PItem^.Value).GraphNode then
|
|
Err;
|
|
AVLNode:=FGraphNodeToNode.Tree.FindSuccessor(AVLNode);
|
|
end;
|
|
|
|
if length(Levels)<>Graph.LevelCount then
|
|
Err;
|
|
for i:=0 to length(Levels)-1 do begin
|
|
Level:=Levels[i];
|
|
for j:=0 to Length(Level.Pairs)-1 do begin
|
|
Pair:=Level.Pairs[j];
|
|
if Pair.Level<>Level then
|
|
Err(Pair.AsString);
|
|
end;
|
|
for j:=0 to length(Level.Nodes)-1 do begin
|
|
Node:=Level.Nodes[j];
|
|
if Node.Level<>Level then
|
|
Err;
|
|
if Node.IndexInLevel<>j then
|
|
Err;
|
|
if Node.GraphNode=nil then
|
|
Err;
|
|
for e:=0 to length(Node.InEdges)-1 do begin
|
|
OtherNode:=Node.InEdges[e];
|
|
if OtherNode=nil then
|
|
Err('node="'+Node.GraphNode.Caption+'" e='+dbgs(e));
|
|
if Node.Level.Index-1<>OtherNode.Level.Index then
|
|
Err('node="'+Node.GraphNode.Caption+'" othernode="'+OtherNode.GraphNode.Caption+'"');
|
|
k:=length(OtherNode.OutEdges)-1;
|
|
while (k>=0) and (OtherNode.OutEdges[k]<>Node) do dec(k);
|
|
if k<0 then
|
|
Err('node="'+Node.GraphNode.Caption+'" othernode="'+OtherNode.GraphNode.Caption+'"');
|
|
end;
|
|
for e:=0 to length(Node.OutEdges)-1 do begin
|
|
OtherNode:=Node.OutEdges[e];
|
|
if OtherNode=nil then
|
|
Err('node="'+Node.GraphNode.Caption+'" e='+dbgs(e));
|
|
if Node.Level.Index+1<>OtherNode.Level.Index then
|
|
Err('node="'+Node.GraphNode.Caption+'" othernode="'+OtherNode.GraphNode.Caption+'"');
|
|
k:=length(OtherNode.InEdges)-1;
|
|
while (k>=0) and (OtherNode.InEdges[k]<>Node) do dec(k);
|
|
if k<0 then
|
|
Err('node="'+Node.GraphNode.Caption+'" othernode="'+OtherNode.GraphNode.Caption+'"');
|
|
end;
|
|
end;
|
|
end;
|
|
for i:=0 to length(Pairs)-1 do begin
|
|
Pair:=Pairs[i];
|
|
if Pair.Graph<>Self then
|
|
Err(Pair.AsString);
|
|
if Pair.Level.Pairs[Pair.Index]<>Pair then
|
|
Err(Pair.AsString);
|
|
if Pair.SwitchDiff<>Pair.ComputeSwitchDiff then
|
|
Err(Pair.AsString);
|
|
end;
|
|
for i:=0 to length(SameSwitchDiffPairs)-1 do begin
|
|
Pair:=SameSwitchDiffPairs[i];
|
|
while Pair<>nil do begin
|
|
if Pair.SwitchDiff<>i-SameSwitchDiffPair0 then
|
|
Err(Pair.AsString);
|
|
if Pair.PrevSameSwitchPair<>nil then begin
|
|
if Pair.PrevSameSwitchPair.NextSameSwitchPair<>Pair then
|
|
Err(Pair.AsString);
|
|
end else begin
|
|
if Pair<>SameSwitchDiffPairs[i] then
|
|
Err(Pair.AsString);
|
|
end;
|
|
if Pair.NextSameSwitchPair<>nil then begin
|
|
if Pair.NextSameSwitchPair.PrevSameSwitchPair<>Pair then
|
|
Err(Pair.AsString);
|
|
end;
|
|
Pair:=Pair.NextSameSwitchPair;
|
|
end;
|
|
end;
|
|
|
|
if CrossCount<>ComputeCrossCount then
|
|
Err;
|
|
if LowestSwitchDiff<>ComputeLowestSwitchDiff(false,nil) then
|
|
Err;
|
|
end;
|
|
|
|
{ TMinXLevel }
|
|
|
|
constructor TMinXLevel.Create(aGraph: TMinXGraph; aIndex: integer);
|
|
var
|
|
i: Integer;
|
|
GraphNode: TLvlGraphNode;
|
|
Node: TMinXNode;
|
|
begin
|
|
Index:=aIndex;
|
|
Graph:=aGraph;
|
|
GraphLevel:=Graph.Graph.Levels[Index];
|
|
SetLength(Nodes,GraphLevel.Count);
|
|
SetLength(BestNodes,length(Nodes));
|
|
for i:=0 to length(Nodes)-1 do begin
|
|
GraphNode:=GraphLevel[i];
|
|
Node:=Graph.GraphNodeToNode(GraphNode);
|
|
Node.Level:=Self;
|
|
Node.IndexInLevel:=i;
|
|
Nodes[i]:=Node;
|
|
BestNodes[i]:=GraphNode;
|
|
end;
|
|
end;
|
|
|
|
destructor TMinXLevel.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(Pairs,0);
|
|
for i:=0 to length(Nodes)-1 do
|
|
Nodes[i].Free;
|
|
SetLength(Nodes,0);
|
|
SetLength(BestNodes,0);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TMinXLevel.GetCrossingCount(Node1, Node2: TMinXNode; out
|
|
Crossing, SwitchCrossing: integer);
|
|
var
|
|
i: Integer;
|
|
j: Integer;
|
|
begin
|
|
Crossing:=0;
|
|
SwitchCrossing:=0;
|
|
for i:=0 to length(Node1.OutEdges)-1 do begin
|
|
for j:=0 to length(Node2.OutEdges)-1 do begin
|
|
if Node1.OutEdges[i]=Node2.OutEdges[j] then continue;
|
|
// these two edges can cross
|
|
if (Node1.IndexInLevel<Node2.IndexInLevel)
|
|
<>(Node1.OutEdges[i].IndexInLevel<Node2.OutEdges[j].IndexInLevel)
|
|
then
|
|
Crossing+=1
|
|
else
|
|
SwitchCrossing+=1;
|
|
end;
|
|
end;
|
|
for i:=0 to length(Node1.InEdges)-1 do begin
|
|
for j:=0 to length(Node2.InEdges)-1 do begin
|
|
if Node1.InEdges[i]=Node2.InEdges[j] then continue;
|
|
// these two edges can cross
|
|
if (Node1.IndexInLevel<Node2.IndexInLevel)
|
|
<>(Node1.InEdges[i].IndexInLevel<Node2.InEdges[j].IndexInLevel)
|
|
then
|
|
Crossing+=1
|
|
else
|
|
SwitchCrossing+=1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TMinXNode }
|
|
|
|
constructor TMinXNode.Create(aNode: TLvlGraphNode);
|
|
begin
|
|
GraphNode:=aNode;
|
|
end;
|
|
|
|
destructor TMinXNode.Destroy;
|
|
begin
|
|
SetLength(InEdges,0);
|
|
SetLength(OutEdges,0);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TLvlGraphNodeStyle }
|
|
|
|
procedure TLvlGraphNodeStyle.SetCaptionPosition(
|
|
AValue: TLvlGraphNodeCaptionPosition);
|
|
begin
|
|
if FCaptionPosition=AValue then Exit;
|
|
FCaptionPosition:=AValue;
|
|
Control.InvalidateAutoLayout;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetCaptionScale(AValue: single);
|
|
begin
|
|
if FCaptionScale=AValue then Exit;
|
|
FCaptionScale:=AValue;
|
|
Control.InvalidateAutoLayout;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetColoring(AValue: TLvlGraphNodeColoring);
|
|
begin
|
|
if FColoring=AValue then Exit;
|
|
FColoring:=AValue;
|
|
if not (csLoading in Control.ComponentState) then begin
|
|
if Coloring=lgncRGB then
|
|
Control.ColorNodesRandomRGB;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetDefaultImageIndex(AValue: integer);
|
|
begin
|
|
if FDefaultImageIndex=AValue then Exit;
|
|
FDefaultImageIndex:=AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetGapBottom(AValue: integer);
|
|
begin
|
|
if FGapBottom=AValue then Exit;
|
|
FGapBottom:=AValue;
|
|
Control.InvalidateAutoLayout;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetGapLeft(AValue: integer);
|
|
begin
|
|
if FGapLeft=AValue then Exit;
|
|
FGapLeft:=AValue;
|
|
Control.InvalidateAutoLayout;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetGapRight(AValue: integer);
|
|
begin
|
|
if FGapRight=AValue then Exit;
|
|
FGapRight:=AValue;
|
|
Control.InvalidateAutoLayout;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetGapTop(AValue: integer);
|
|
begin
|
|
if FGapTop=AValue then Exit;
|
|
FGapTop:=AValue;
|
|
Control.InvalidateAutoLayout;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetShape(AValue: TLvlGraphNodeShape);
|
|
begin
|
|
if FShape=AValue then Exit;
|
|
FShape:=AValue;
|
|
Control.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.SetWidth(AValue: integer);
|
|
begin
|
|
if FWidth=AValue then Exit;
|
|
FWidth:=AValue;
|
|
Control.InvalidateAutoLayout;
|
|
end;
|
|
|
|
constructor TLvlGraphNodeStyle.Create(AControl: TCustomLvlGraphControl);
|
|
begin
|
|
FControl:=AControl;
|
|
FWidth:=DefaultLvlGraphNodeWith;
|
|
FGapLeft:=DefaultLvlGraphNodeGapLeft;
|
|
FGapTop:=DefaultLvlGraphNodeGapTop;
|
|
FGapRight:=DefaultLvlGraphNodeGapRight;
|
|
FGapBottom:=DefaultLvlGraphNodeGapBottom;
|
|
FCaptionScale:=DefaultLvlGraphNodeCaptionScale;
|
|
FCaptionPosition:=DefaultLvlGraphNodeCaptionPosition;
|
|
FShape:=DefaultLvlGraphNodeShape;
|
|
FDefaultImageIndex:=-1;
|
|
FColoring:=DefaultLvlGraphNodeColoring;
|
|
end;
|
|
|
|
destructor TLvlGraphNodeStyle.Destroy;
|
|
begin
|
|
FControl.FNodeStyle:=nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLvlGraphNodeStyle.Assign(Source: TPersistent);
|
|
var
|
|
Src: TLvlGraphNodeStyle;
|
|
begin
|
|
if Source is TLvlGraphNodeStyle then begin
|
|
Src:=TLvlGraphNodeStyle(Source);
|
|
Width:=Src.Width;
|
|
GapLeft:=Src.GapLeft;
|
|
GapRight:=Src.GapRight;
|
|
GapTop:=Src.GapTop;
|
|
GapBottom:=Src.GapBottom;
|
|
CaptionScale:=Src.CaptionScale;
|
|
CaptionPosition:=Src.CaptionPosition;
|
|
Shape:=Src.Shape;
|
|
DefaultImageIndex:=Src.DefaultImageIndex;
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TLvlGraphNodeStyle.Equals(Obj: TObject): boolean;
|
|
var
|
|
Src: TLvlGraphNodeStyle;
|
|
begin
|
|
Result:=inherited Equals(Obj);
|
|
if not Result then exit;
|
|
if Obj is TLvlGraphNodeStyle then begin
|
|
Src:=TLvlGraphNodeStyle(Obj);
|
|
Result:=(Width=Src.Width)
|
|
and (GapLeft=Src.GapLeft)
|
|
and (GapRight=Src.GapRight)
|
|
and (GapTop=Src.GapTop)
|
|
and (GapBottom=Src.GapBottom)
|
|
and (CaptionScale=Src.CaptionScale)
|
|
and (CaptionPosition=Src.CaptionPosition)
|
|
and (Shape=Src.Shape)
|
|
and (DefaultImageIndex=Src.DefaultImageIndex);
|
|
end;
|
|
end;
|
|
|
|
{ TLvlGraphLevel }
|
|
|
|
function TLvlGraphLevel.GetNodes(Index: integer): TLvlGraphNode;
|
|
begin
|
|
Result:=TLvlGraphNode(fNodes[Index]);
|
|
end;
|
|
|
|
procedure TLvlGraphLevel.SetDrawPosition(AValue: integer);
|
|
begin
|
|
if FDrawPosition=AValue then Exit;
|
|
FDrawPosition:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphLevel.MoveNode(Node: TLvlGraphNode; NewIndexInLevel: integer
|
|
);
|
|
var
|
|
OldIndexInLevel: Integer;
|
|
begin
|
|
OldIndexInLevel:=fNodes.IndexOf(Node);
|
|
if OldIndexInLevel=NewIndexInLevel then exit;
|
|
fNodes.Move(OldIndexInLevel,NewIndexInLevel);
|
|
end;
|
|
|
|
constructor TLvlGraphLevel.Create(TheGraph: TLvlGraph; TheIndex: integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FGraph:=TheGraph;
|
|
if TheIndex < FGraph.fLevels.Count then begin
|
|
FGraph.fLevels.Insert(TheIndex, Self);
|
|
for i := TheIndex + 1 to FGraph.fLevels.Count - 1 do
|
|
TLvlGraphLevel(FGraph.fLevels[i]).FIndex := TLvlGraphLevel(FGraph.fLevels[i]).Index + 1;
|
|
end
|
|
else
|
|
FGraph.fLevels.Add(Self);
|
|
FIndex:=TheIndex;
|
|
fNodes:=TFPList.Create;
|
|
if Graph<>nil then
|
|
Graph.StructureChanged(Self,opInsert);
|
|
end;
|
|
|
|
destructor TLvlGraphLevel.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to Count-1 do
|
|
Nodes[i].OnLevelDestroy;
|
|
if Count>0 then
|
|
raise Exception.Create('');
|
|
FreeAndNil(fNodes);
|
|
Graph.InternalRemoveLevel(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLvlGraphLevel.Invalidate;
|
|
begin
|
|
if Graph<>nil then
|
|
Graph.Invalidate;
|
|
end;
|
|
|
|
function TLvlGraphLevel.IndexOf(Node: TLvlGraphNode): integer;
|
|
begin
|
|
for Result:=0 to Count-1 do
|
|
if Nodes[Result]=Node then exit;
|
|
Result:=-1;
|
|
end;
|
|
|
|
function TLvlGraphLevel.Count: integer;
|
|
begin
|
|
Result:=fNodes.Count;
|
|
end;
|
|
|
|
function TLvlGraphLevel.GetTotalInOutWeights: single;
|
|
var
|
|
i: Integer;
|
|
Node: TLvlGraphNode;
|
|
begin
|
|
Result:=0;
|
|
for i:=0 to Count-1 do begin
|
|
Node:=Nodes[i];
|
|
Result+=Max(Node.InWeight,Node.OutWeight);
|
|
end;
|
|
end;
|
|
|
|
{ TCustomLvlGraphControl }
|
|
|
|
procedure TCustomLvlGraphControl.GraphInvalidate(Sender: TObject);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.GraphStructureChanged(Sender,
|
|
Element: TObject; Operation: TOperation);
|
|
begin
|
|
if ((Element is TLvlGraphNode)
|
|
or (Element is TLvlGraphEdge)) then begin
|
|
if Operation=opRemove then begin
|
|
if FNodeUnderMouse=Element then
|
|
FNodeUnderMouse:=nil;
|
|
end;
|
|
//debugln(['TCustomLvlGraphControl.GraphStructureChanged ']);
|
|
if lgoAutoLayout in FOptions then
|
|
InvalidateAutoLayout;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.SetNodeUnderMouse(AValue: TLvlGraphNode);
|
|
begin
|
|
if FNodeUnderMouse=AValue then Exit;
|
|
FNodeUnderMouse:=AValue;
|
|
if lgoHighlightNodeUnderMouse in Options then
|
|
HighlightConnectedEgdes(NodeUnderMouse);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DrawEdges(Highlighted: boolean);
|
|
var
|
|
i: Integer;
|
|
Level: TLvlGraphLevel;
|
|
j: Integer;
|
|
Node: TLvlGraphNode;
|
|
k: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
TargetNode: TLvlGraphNode;
|
|
begin
|
|
for i:=0 to Graph.LevelCount-1 do begin
|
|
Level:=Graph.Levels[i];
|
|
for j:=0 to Level.Count-1 do begin
|
|
Node:=Level.Nodes[j];
|
|
for k:=0 to Node.OutEdgeCount-1 do begin
|
|
Edge:=Node.OutEdges[k];
|
|
TargetNode:=Edge.Target;
|
|
if Edge.Highlighted<>Highlighted then continue;
|
|
// compare Level in case MarkBackEdges was skipped
|
|
if (TargetNode.Level.Index>Level.Index) and (not Edge.BackEdge) then begin
|
|
// normal dependency
|
|
// => draw line from right of Node to left of TargetNode
|
|
if Edge.Highlighted then
|
|
Canvas.Pen.Color:=EdgeStyle.HighlightColor
|
|
else
|
|
Canvas.Pen.Color:=EdgeStyle.Color;
|
|
end else begin
|
|
// cycle dependency
|
|
// => draw line from left of Node to right of TargetNode
|
|
if Edge.Highlighted then
|
|
Canvas.Pen.Color:=EdgeStyle.BackHighlightColor
|
|
else
|
|
Canvas.Pen.Color:=EdgeStyle.BackColor;
|
|
end;
|
|
DoDrawEdge(Edge);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.GraphSelectionChanged(Sender: TObject);
|
|
begin
|
|
if OnSelectionChanged<>nil then
|
|
OnSelectionChanged(Self);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.ImageListChange(Sender: TObject);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DrawCaptions(const TxtH: integer);
|
|
var
|
|
Node: TLvlGraphNode;
|
|
j: Integer;
|
|
Level: TLvlGraphLevel;
|
|
i: Integer;
|
|
TxtW: Integer;
|
|
p: TPoint;
|
|
x: Integer;
|
|
y: Integer;
|
|
Details: TThemedElementDetails;
|
|
NodeRect: TRect;
|
|
begin
|
|
Canvas.Font.Height:=round(single(TxtH)*NodeStyle.CaptionScale+0.5);
|
|
for i:=0 to Graph.LevelCount-1 do begin
|
|
Level:=Graph.Levels[i];
|
|
for j:=0 to Level.Count-1 do begin
|
|
Node:=Level.Nodes[j];
|
|
if (Node.Caption='') or (not Node.Visible) then continue;
|
|
TxtW:=Canvas.TextWidth(Node.Caption);
|
|
case NodeStyle.CaptionPosition of
|
|
lgncLeft,lgncRight: p.y:=Node.DrawCenter-(TxtH div 2);
|
|
lgncTop: p.y:=Node.DrawPosition-NodeStyle.GapTop-TxtH;
|
|
lgncBottom: p.y:=Node.DrawPositionEnd+NodeStyle.GapBottom;
|
|
end;
|
|
case NodeStyle.CaptionPosition of
|
|
lgncLeft: p.x:=Level.DrawPosition-NodeStyle.GapLeft-TxtW;
|
|
lgncRight: p.x:=Level.DrawPosition+NodeStyle.Width+NodeStyle.GapRight;
|
|
lgncTop,lgncBottom: p.x:=Level.DrawPosition+((NodeStyle.Width-TxtW) div 2);
|
|
end;
|
|
//debugln(['TCustomLvlGraphControl.Paint ',Node.Caption,' DrawPosition=',Node.DrawPosition,' DrawSize=',Node.DrawSize,' TxtH=',TxtH,' TxtW=',TxtW,' p=',dbgs(p),' Selected=',Node.Selected]);
|
|
x:=p.x-ScrollLeft;
|
|
y:=p.y-ScrollTop;
|
|
NodeRect:=Bounds(x,y,TxtW,TxtH);
|
|
Node.FDrawnCaptionRect:=NodeRect;
|
|
if Node.Selected then begin
|
|
if lgcFocusedPainting in FFlags then
|
|
Details := ThemeServices.GetElementDetails(ttItemSelected)
|
|
else
|
|
Details := ThemeServices.GetElementDetails(ttItemSelectedNotFocus);
|
|
ThemeServices.DrawElement(Canvas.Handle, Details, NodeRect, nil);
|
|
end else begin
|
|
Details := ThemeServices.GetElementDetails(ttItemNormal);
|
|
//Canvas.Brush.Style:=bsClear;
|
|
//Canvas.Brush.Color:=clNone;
|
|
end;
|
|
ThemeServices.DrawText(Canvas, Details, Node.Caption, NodeRect,
|
|
DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0)
|
|
//Canvas.TextOut(x,y,Node.Caption);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.ComputeEdgeCoords;
|
|
var
|
|
l: Integer;
|
|
Level: TLvlGraphLevel;
|
|
n: Integer;
|
|
Node: TLvlGraphNode;
|
|
e: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
TargetNode: TLvlGraphNode;
|
|
x1: Integer;
|
|
x2: Integer;
|
|
TotalWeight, Weight: Single;
|
|
Start: Integer;
|
|
begin
|
|
for l:=0 to Graph.LevelCount-1 do begin
|
|
Level:=Graph.Levels[l];
|
|
for n:=0 to Level.Count-1 do begin
|
|
Node:=Level.Nodes[n];
|
|
|
|
// out edges
|
|
TotalWeight:=Node.OutWeight;
|
|
Weight:=0.0;
|
|
Start:=Node.DrawCenter-ScrollTop-integer(round(TotalWeight*PixelPerWeight) div 2);
|
|
for e:=0 to Node.OutEdgeCount-1 do begin
|
|
Edge:=Node.OutEdges[e];
|
|
Edge.FDrawnAt.Top:=Start+round(Weight*PixelPerWeight);
|
|
Weight+=Edge.Weight;
|
|
end;
|
|
|
|
// in edges
|
|
TotalWeight:=Node.InWeight;
|
|
Weight:=0.0;
|
|
Start:=Node.DrawCenter-ScrollTop-integer(round(TotalWeight*PixelPerWeight) div 2);
|
|
for e:=0 to Node.InEdgeCount-1 do begin
|
|
Edge:=Node.InEdges[e];
|
|
Edge.FDrawnAt.Bottom:=Start+round(Weight*PixelPerWeight);
|
|
Weight+=Edge.Weight;
|
|
end;
|
|
|
|
// x1, x2
|
|
for e:=0 to Node.OutEdgeCount-1 do begin
|
|
Edge:=Node.OutEdges[e];
|
|
TargetNode:=Edge.Target;
|
|
x1:=Level.DrawPosition-ScrollLeft;
|
|
x2:=TargetNode.Level.DrawPosition-ScrollLeft;
|
|
if TargetNode.Level.Index>Level.Index then begin
|
|
// normal dependency
|
|
// => draw line from right of Node to left of TargetNode
|
|
if Node.Visible then
|
|
x1+=NodeStyle.Width
|
|
else
|
|
x1+=NodeStyle.Width div 2;
|
|
if not TargetNode.Visible then
|
|
x2+=NodeStyle.Width div 2;
|
|
end else begin
|
|
// This code is only reachable if MarkBackEdges was skipped
|
|
// cycle dependency
|
|
// => draw line from left of Node to right of TargetNode
|
|
if not Node.Visible then
|
|
x1+=NodeStyle.Width div 2;
|
|
if TargetNode.Visible then
|
|
x2+=NodeStyle.Width
|
|
else
|
|
x2+=NodeStyle.Width div 2;
|
|
end;
|
|
Edge.FDrawnAt.Left:=x1;
|
|
Edge.FDrawnAt.Right:=x2;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.ColorNodesRandomRGB;
|
|
var
|
|
Palette: TLazCtrlPalette;
|
|
begin
|
|
Palette:=GetCCPaletteRGB(Graph.NodeCount, true);
|
|
Graph.SetColors(Palette);
|
|
SetLength(Palette, 0);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DrawNodes;
|
|
var
|
|
i: Integer;
|
|
Level: TLvlGraphLevel;
|
|
j: Integer;
|
|
Node: TLvlGraphNode;
|
|
x: Integer;
|
|
y: Integer;
|
|
ImgIndex: Integer;
|
|
begin
|
|
Canvas.Brush.Style:=bsSolid;
|
|
for i:=0 to Graph.LevelCount-1 do begin
|
|
Level:=Graph.Levels[i];
|
|
for j:=0 to Level.Count-1 do begin
|
|
Node:=Level.Nodes[j];
|
|
if not Node.Visible then continue;
|
|
//debugln(['TCustomLvlGraphControl.Paint ',Node.Caption,' ',dbgs(FPColorToTColor(Node.Color)),' Level.DrawPosition=',Level.DrawPosition,' Node.DrawPosition=',Node.DrawPosition,' ',Node.DrawPositionEnd]);
|
|
|
|
// draw shape
|
|
Canvas.Brush.Color:=FPColorToTColor(Node.Color);
|
|
Canvas.Pen.Color:=Darker(Canvas.Brush.Color);
|
|
x:=Level.DrawPosition-ScrollLeft;
|
|
y:=Node.DrawPosition-ScrollTop;
|
|
case NodeStyle.Shape of
|
|
lgnsRectangle:
|
|
Canvas.Rectangle(x, y, x+NodeStyle.Width, y+Node.DrawSize);
|
|
lgnsEllipse:
|
|
Canvas.Ellipse(x, y, x+NodeStyle.Width, y+Node.DrawSize);
|
|
end;
|
|
|
|
// draw image and overlay
|
|
if (Images<>nil) then begin
|
|
x:=Level.DrawPosition+((NodeStyle.Width-Images.Width) div 2)-ScrollLeft;
|
|
y:=Node.DrawCenter-(Images.Height div 2)-ScrollTop;
|
|
ImgIndex:=Node.ImageIndex;
|
|
if (ImgIndex<0) or (ImgIndex>=Images.Count) then
|
|
ImgIndex:=NodeStyle.DefaultImageIndex;
|
|
if (ImgIndex>=0) and (ImgIndex<Images.Count) then begin
|
|
Images.Draw(Canvas, x, y, ImgIndex, Node.FImageEffect);
|
|
if (Node.OverlayIndex>=0) and (Node.OverlayIndex<Images.Count) then
|
|
Images.DrawOverlay(Canvas, x, y, ImgIndex, Node.OverlayIndex, Node.FImageEffect);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomLvlGraphControl.GetSelectedNode: TLvlGraphNode;
|
|
begin
|
|
Result:=Graph.FirstSelected;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.SetEdgeNearMouse(AValue: TLvlGraphEdge);
|
|
begin
|
|
if FEdgeNearMouse=AValue then Exit;
|
|
FEdgeNearMouse:=AValue;
|
|
if (lgoHighlightEdgeNearMouse in Options)
|
|
and ((NodeUnderMouse=nil) or (not (lgoHighlightNodeUnderMouse in Options)))
|
|
then
|
|
HighlightConnectedEgdes(EdgeNearMouse);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.SetImages(AValue: TCustomImageList);
|
|
begin
|
|
if FImages=AValue then Exit;
|
|
if Images <> nil then
|
|
Images.UnRegisterChanges(FImageChangeLink);
|
|
FImages:=AValue;
|
|
if Images <> nil then begin
|
|
Images.RegisterChanges(FImageChangeLink);
|
|
Images.FreeNotification(Self);
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.SetNodeStyle(AValue: TLvlGraphNodeStyle);
|
|
begin
|
|
if FNodeStyle=AValue then Exit;
|
|
FNodeStyle.Assign(AValue);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.SetOptions(AValue: TLvlGraphCtrlOptions);
|
|
begin
|
|
if FOptions=AValue then Exit;
|
|
FOptions:=AValue;
|
|
InvalidateAutoLayout;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.SetScrollLeft(AValue: integer);
|
|
begin
|
|
AValue:=Max(0,Min(AValue,ScrollLeftMax));
|
|
if FScrollLeft=AValue then Exit;
|
|
FScrollLeft:=AValue;
|
|
UpdateScrollBars;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.SetScrollTop(AValue: integer);
|
|
begin
|
|
AValue:=Max(0,Min(AValue,ScrollTopMax));
|
|
if FScrollTop=AValue then Exit;
|
|
FScrollTop:=AValue;
|
|
UpdateScrollBars;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.SetSelectedNode(AValue: TLvlGraphNode);
|
|
begin
|
|
if AValue=nil then
|
|
Graph.ClearSelection
|
|
else
|
|
Graph.SingleSelect(AValue);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.UpdateScrollBars;
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
DrawSize: TPoint;
|
|
begin
|
|
if HandleAllocated and (not (lgcUpdatingScrollBars in FFlags)) then begin
|
|
Include(FFlags,lgcUpdatingScrollBars);
|
|
DrawSize:=GetDrawSize;
|
|
FScrollTopMax:=DrawSize.Y-ClientHeight+2*BorderWidth;
|
|
FScrollTop:=Max(0,Min(FScrollTop,ScrollTopMax));
|
|
FScrollLeftMax:=DrawSize.X-ClientWidth+2*BorderWidth;
|
|
FScrollLeft:=Max(0,Min(FScrollLeft,ScrollLeftMax));
|
|
//debugln(['TCustomLvlGraphControl.UpdateScrollBars ',dbgs(DrawSize),' ClientRect=',dbgs(ClientRect),' ScrollLeft=',ScrollLeft,'/',ScrollLeftMax,' ScrollTop=',ScrollTop,'/',ScrollTopMax,' ']);
|
|
|
|
// vertical scrollbar
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
|
|
ScrollInfo.nMin := 0;
|
|
ScrollInfo.nTrackPos := 0;
|
|
ScrollInfo.nMax := DrawSize.Y;
|
|
ScrollInfo.nPage := Max(1,ClientHeight-1);
|
|
ScrollInfo.nPos := ScrollTop;
|
|
ShowScrollBar(Handle, SB_VERT, True);
|
|
SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
|
|
|
|
// horizontal scrollbar
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
|
|
ScrollInfo.nMin := 0;
|
|
ScrollInfo.nTrackPos := 0;
|
|
ScrollInfo.nMax := DrawSize.X;
|
|
ScrollInfo.nPage := Max(1,ClientWidth-1);
|
|
ScrollInfo.nPos := ScrollLeft;
|
|
ShowScrollBar(Handle, SB_Horz, True);
|
|
SetScrollInfo(Handle, SB_Horz, ScrollInfo, True);
|
|
|
|
Exclude(FFlags,lgcUpdatingScrollBars);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.WMHScroll(var Msg: TLMScroll);
|
|
begin
|
|
case Msg.ScrollCode of
|
|
SB_TOP: ScrollLeft := 0;
|
|
SB_BOTTOM: ScrollLeft := ScrollLeftMax;
|
|
SB_LINEDOWN: ScrollLeft := ScrollLeft + NodeStyle.Width div 2;
|
|
SB_LINEUP: ScrollLeft := ScrollLeft - NodeStyle.Width div 2;
|
|
SB_PAGEDOWN: ScrollLeft := ScrollLeft + ClientWidth - NodeStyle.Width;
|
|
SB_PAGEUP: ScrollLeft := ScrollLeft - ClientWidth + NodeStyle.Width;
|
|
SB_THUMBPOSITION,
|
|
SB_THUMBTRACK: ScrollLeft := Msg.Pos;
|
|
SB_ENDSCROLL: SetCaptureControl(nil); // release scrollbar capture
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.WMVScroll(var Msg: TLMScroll);
|
|
begin
|
|
case Msg.ScrollCode of
|
|
SB_TOP: ScrollTop := 0;
|
|
SB_BOTTOM: ScrollTop := ScrollTopMax;
|
|
SB_LINEDOWN: ScrollTop := ScrollTop + NodeStyle.Width div 2;
|
|
SB_LINEUP: ScrollTop := ScrollTop - NodeStyle.Width div 2;
|
|
SB_PAGEDOWN: ScrollTop := ScrollTop + ClientHeight - NodeStyle.Width;
|
|
SB_PAGEUP: ScrollTop := ScrollTop - ClientHeight + NodeStyle.Width;
|
|
SB_THUMBPOSITION,
|
|
SB_THUMBTRACK: ScrollTop := Msg.Pos;
|
|
SB_ENDSCROLL: SetCaptureControl(nil); // release scrollbar capture
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.WMMouseWheel(var Message: TLMMouseEvent);
|
|
begin
|
|
if Mouse.WheelScrollLines=-1 then
|
|
begin
|
|
// -1 : scroll by page
|
|
ScrollTop := ScrollTop -
|
|
(Message.WheelDelta * (ClientHeight - NodeStyle.Width)) div 120;
|
|
end else begin
|
|
// scrolling one line -> scroll half an item, see SB_LINEDOWN and SB_LINEUP
|
|
// handler in WMVScroll
|
|
ScrollTop := ScrollTop -
|
|
(Message.WheelDelta * Mouse.WheelScrollLines*NodeStyle.Width) div 240;
|
|
end;
|
|
Message.Result := 1;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DoAutoLayoutLevels(TxtHeight: integer);
|
|
// compute all Levels.DrawPosition
|
|
var
|
|
j: Integer;
|
|
p: Integer;
|
|
i: Integer;
|
|
LevelTxtWidths: array of integer;
|
|
Level: TLvlGraphLevel;
|
|
begin
|
|
Canvas.Font.Height:=round(single(TxtHeight)*NodeStyle.CaptionScale+0.5);
|
|
if Graph.LevelCount=0 then exit;
|
|
SetLength(LevelTxtWidths,Graph.LevelCount);
|
|
for i:=0 to Graph.LevelCount-1 do begin
|
|
// compute needed width of the level
|
|
Level:=Graph.Levels[i];
|
|
LevelTxtWidths[i]:=Max(NodeStyle.Width,Canvas.TextWidth('NodeX'+StringOfChar('j',Min(20,Level.Count))));
|
|
for j:=0 to Level.Count-1 do
|
|
if Level[j].Visible then
|
|
LevelTxtWidths[i]:=Max(LevelTxtWidths[i], Canvas.TextWidth(Level[j].Caption));
|
|
p:=0; // Prevent compiler warning.
|
|
if i=0 then begin
|
|
// first level
|
|
case NodeStyle.CaptionPosition of
|
|
lgncLeft: p:=NodeStyle.GapRight+LevelTxtWidths[0]+NodeStyle.GapLeft;
|
|
lgncRight: p:=NodeStyle.GapLeft;
|
|
lgncTop,lgncBottom: p:=NodeStyle.GapLeft+((LevelTxtWidths[0]-NodeStyle.Width) div 2);
|
|
end;
|
|
end else begin
|
|
// following level
|
|
p:=Graph.Levels[i-1].DrawPosition;
|
|
case NodeStyle.CaptionPosition of
|
|
lgncLeft: p+=NodeStyle.Width+NodeStyle.GapRight+LevelTxtWidths[i]+NodeStyle.GapLeft;
|
|
lgncRight: p+=NodeStyle.Width+NodeStyle.GapRight+LevelTxtWidths[i-1]+NodeStyle.GapLeft;
|
|
lgncTop,lgncBottom:
|
|
p+=((LevelTxtWidths[i-1]+LevelTxtWidths[i]) div 2)+NodeStyle.GapRight+NodeStyle.GapLeft;
|
|
end;
|
|
end;
|
|
Graph.Levels[i].DrawPosition:=p;
|
|
end;
|
|
SetLength(LevelTxtWidths,0);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DoSetBounds(ALeft, ATop, AWidth,
|
|
AHeight: integer);
|
|
begin
|
|
inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
|
|
UpdateScrollBars;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DoStartAutoLayout;
|
|
begin
|
|
if Assigned(OnStartAutoLayout) then
|
|
OnStartAutoLayout(Self);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DoEndAutoLayout;
|
|
begin
|
|
if Assigned(OnEndAutoLayout) then
|
|
OnEndAutoLayout(Self);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DoDrawEdge(Edge: TLvlGraphEdge);
|
|
var
|
|
r: TRect;
|
|
s, Ascend, FarAscend: integer;
|
|
Source, Target, FarSource, FarTarget: TLvlGraphNode;
|
|
SourceStraighenFactor, TargetStraighenFactor: Single;
|
|
begin
|
|
SourceStraighenFactor := 0;
|
|
TargetStraighenFactor := 0;
|
|
if EdgeStyle.Shape = lgesCurved then begin
|
|
Source := Edge.Source;
|
|
Target := Edge.Target;
|
|
Ascend := (Source.DrawCenter - Target.DrawCenter) * 1024
|
|
div (Target.Level.DrawPosition - Source.Level.DrawPosition);
|
|
if (not Source.Visible) and (Source.OutEdgeCount = 1) and (Source.InEdgeCount = 1) then begin
|
|
FarSource := Source.InEdges[0].Source;
|
|
FarAscend := (FarSource.DrawCenter - Source.DrawCenter) * 1024
|
|
div (Source.Level.DrawPosition - FarSource.Level.DrawPosition);
|
|
if ((Ascend < 0) and (FarAscend < 0)) then
|
|
SourceStraighenFactor := Max(Ascend, FarAscend) / 1024
|
|
else
|
|
if ((Ascend > 0) and (FarAscend > 0)) then
|
|
SourceStraighenFactor := Min(Ascend, FarAscend) / 1024;
|
|
end;
|
|
if (not Target.Visible) and (Target.OutEdgeCount = 1) and (Target.InEdgeCount = 1) then begin
|
|
FarTarget := Target.OutEdges[0].Target;
|
|
FarAscend := (Target.DrawCenter - FarTarget.DrawCenter) * 1024
|
|
div (FarTarget.Level.DrawPosition - Target.Level.DrawPosition);
|
|
if ((Ascend < 0) and (FarAscend < 0)) then
|
|
TargetStraighenFactor := Max(Ascend, FarAscend) / 1024
|
|
else
|
|
if ((Ascend > 0) and (FarAscend > 0)) then
|
|
TargetStraighenFactor := Min(Ascend, FarAscend) / 1024;
|
|
end;
|
|
end;
|
|
|
|
r:=Edge.DrawnAt;
|
|
if Edge.FNoGapCircle then begin
|
|
if EdgeStyle.Shape = lgesCurved then begin
|
|
if Edge.BackEdge then begin
|
|
SourceStraighenFactor := -0.4;
|
|
TargetStraighenFactor := 0.4;
|
|
end else begin
|
|
SourceStraighenFactor := 0.4;
|
|
TargetStraighenFactor := -0.4;
|
|
end;
|
|
end else begin
|
|
if Edge.BackEdge then begin
|
|
inc(r.Top, 2);
|
|
inc(r.Bottom, 2);
|
|
end else begin
|
|
dec(r.Top);
|
|
dec(r.Bottom);
|
|
end;
|
|
end;
|
|
end;
|
|
s:=round(Edge.Weight*PixelPerWeight);
|
|
if s>1 then begin
|
|
case EdgeStyle.Shape of
|
|
lgesStraight: Canvas.Line(r);
|
|
lgesCurved:
|
|
begin
|
|
DrawCurvedLvlLeftToRightEdge(Canvas,r.Left,r.Top,r.Right,r.Bottom, SourceStraighenFactor, TargetStraighenFactor);
|
|
DrawCurvedLvlLeftToRightEdge(Canvas,r.Left,r.Top+s,r.Right,r.Bottom+s, SourceStraighenFactor, TargetStraighenFactor);
|
|
end;
|
|
end;
|
|
end else begin
|
|
case EdgeStyle.Shape of
|
|
lgesStraight: Canvas.Line(r);
|
|
lgesCurved: DrawCurvedLvlLeftToRightEdge(Canvas,r.Left,r.Top,r.Right,r.Bottom, SourceStraighenFactor, TargetStraighenFactor);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DoMinimizeCrossings;
|
|
begin
|
|
if OnMinimizeCrossings<>nil then
|
|
OnMinimizeCrossings(Self)
|
|
else
|
|
Graph.MinimizeCrossings;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DoMinimizeOverlappings(MinPos: integer;
|
|
NodeGapInFront: integer; NodeGapBehind: integer);
|
|
var
|
|
Handled: Boolean;
|
|
begin
|
|
Handled := False;
|
|
if Assigned(OnMinimizeOverlappings) then
|
|
OnMinimizeOverlappings(MinPos,NodeGapInFront,NodeGapBehind,Handled);
|
|
if not Handled then
|
|
Graph.MinimizeOverlappings(MinPos,NodeGapInFront,NodeGapBehind);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.Paint;
|
|
var
|
|
w: Integer;
|
|
TxtH: integer;
|
|
begin
|
|
inherited Paint;
|
|
|
|
Canvas.Font.Assign(Font);
|
|
Canvas.Font.PixelsPerInch := Font.PixelsPerInch;
|
|
|
|
Include(FFlags,lgcFocusedPainting);
|
|
|
|
if (lgoAutoLayout in FOptions)
|
|
and (lgcNeedAutoLayout in FFlags) then begin
|
|
Include(FFlags,lgcIgnoreGraphInvalidate);
|
|
try
|
|
AutoLayout;
|
|
finally
|
|
Exclude(FFlags,lgcIgnoreGraphInvalidate);
|
|
end;
|
|
end;
|
|
|
|
// background
|
|
if Draw(lgdsBackground) then begin
|
|
Canvas.Brush.Style:=bsSolid;
|
|
Canvas.Brush.Color:=Color; //clWhite;
|
|
Canvas.FillRect(ClientRect);
|
|
end;
|
|
|
|
TxtH:=Canvas.TextHeight('ABCTM');
|
|
|
|
// header
|
|
if Draw(lgdsHeader) and (Caption<>'') then begin
|
|
w:=Canvas.TextWidth(Caption);
|
|
Canvas.TextOut((ClientWidth-w) div 2-ScrollLeft,round(0.25*TxtH)-ScrollTop,Caption);
|
|
end;
|
|
|
|
// draw edges, node captions, nodes
|
|
ComputeEdgeCoords;
|
|
if Draw(lgdsNormalEdges) then
|
|
DrawEdges(false);
|
|
if Draw(lgdsNodeCaptions) then
|
|
DrawCaptions(TxtH);
|
|
if Draw(lgdsHighlightedEdges) then
|
|
DrawEdges(true);
|
|
if Draw(lgdsNodes) then
|
|
DrawNodes;
|
|
|
|
// finish
|
|
Draw(lgdsFinish);
|
|
end;
|
|
|
|
function TCustomLvlGraphControl.Draw(Step: TLvlGraphDrawStep): boolean;
|
|
var
|
|
Skip: Boolean;
|
|
begin
|
|
if not Assigned(OnDrawStep) then exit(true);
|
|
Skip:=false;
|
|
OnDrawStep(Step,Skip);
|
|
Result:=not Skip;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Distance: integer;
|
|
Edge: TLvlGraphEdge;
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
NodeUnderMouse:=GetNodeAt(X,Y);
|
|
Edge:=GetEdgeAt(X,Y,Distance);
|
|
if Distance<=EdgeStyle.MouseDistMax then
|
|
EdgeNearMouse:=Edge
|
|
else
|
|
EdgeNearMouse:=nil;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Node: TLvlGraphNode;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
Node:=GetNodeAt(X,Y);
|
|
if Node<>nil then begin
|
|
if Button=mbLeft then begin
|
|
if lgoMouseSelects in Options then begin
|
|
if ssCtrl in Shift then begin
|
|
// toggle selection
|
|
Node.Selected:=not Node.Selected;
|
|
end else begin
|
|
// single selection
|
|
Graph.ClearSelection;
|
|
Node.Selected:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
UpdateScrollBars;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.HighlightConnectedEgdes(Element: TObject);
|
|
var
|
|
n: Integer;
|
|
CurNode: TLvlGraphNode;
|
|
e: Integer;
|
|
HighlightedElements: TAvlTree;
|
|
Edge: TLvlGraphEdge;
|
|
begin
|
|
BeginUpdate;
|
|
HighlightedElements:=TAvlTree.Create;
|
|
try
|
|
if Element is TLvlGraphNode then
|
|
LvlGraphHighlightNode(TLvlGraphNode(Element),HighlightedElements,true,true)
|
|
else if Element is TLvlGraphEdge then begin
|
|
Edge:=TLvlGraphEdge(Element);
|
|
HighlightedElements.Add(Edge);
|
|
if not Edge.Source.Visible then
|
|
LvlGraphHighlightNode(Edge.Source,HighlightedElements,true,false);
|
|
if not Edge.Target.Visible then
|
|
LvlGraphHighlightNode(Edge.Target,HighlightedElements,false,true);
|
|
end;
|
|
for n:=0 to Graph.NodeCount-1 do begin
|
|
CurNode:=Graph.Nodes[n];
|
|
for e:=0 to CurNode.OutEdgeCount-1 do begin
|
|
Edge:=CurNode.OutEdges[e];
|
|
Edge.Highlighted:=HighlightedElements.Find(Edge)<>nil;
|
|
end;
|
|
end;
|
|
finally
|
|
HighlightedElements.Free;
|
|
end;
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.DoOnShowHint(HintInfo: PHintInfo);
|
|
var
|
|
s: String;
|
|
begin
|
|
if NodeUnderMouse<>nil then begin
|
|
s:=NodeArrayAsString(NodeUnderMouse.GetVisibleSourceNodes);
|
|
s+=#13'->'#13;
|
|
s+=NodeUnderMouse.Caption;
|
|
s+=#13'->'#13;
|
|
s+=NodeArrayAsString(NodeUnderMouse.GetVisibleTargetNodes);
|
|
HintInfo^.HintStr:=s;
|
|
end else if EdgeNearMouse<>nil then begin
|
|
s:=NodeArrayAsString(EdgeNearMouse.GetVisibleSourceNodes);
|
|
s+=#13'->'#13;
|
|
s+=NodeArrayAsString(EdgeNearMouse.GetVisibleTargetNodes);
|
|
HintInfo^.HintStr:=s;
|
|
end;
|
|
|
|
inherited DoOnShowHint(HintInfo);
|
|
end;
|
|
|
|
constructor TCustomLvlGraphControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle:=ControlStyle+[csAcceptsControls];
|
|
Color := clWhite;
|
|
FOptions:=DefaultLvlGraphCtrlOptions;
|
|
FGraph:=TLvlGraph.Create;
|
|
FGraph.OnInvalidate:=@GraphInvalidate;
|
|
FGraph.OnSelectionChanged:=@GraphSelectionChanged;
|
|
FGraph.OnStructureChanged:=@GraphStructureChanged;
|
|
FNodeStyle:=TLvlGraphNodeStyle.Create(Self);
|
|
FEdgeStyle:=TLvlGraphEdgeStyle.Create(Self);
|
|
FLimits:=TLvlGraphLimits.Create(Self);
|
|
FImageChangeLink := TChangeLink.Create;
|
|
FImageChangeLink.OnChange:=@ImageListChange;
|
|
ShowHint:=true;
|
|
with GetControlClassDefaultSize do
|
|
SetInitialBounds(0, 0, CX, CY);
|
|
end;
|
|
|
|
destructor TCustomLvlGraphControl.Destroy;
|
|
begin
|
|
inc(fUpdateLock);
|
|
FreeAndNil(FImageChangeLink);
|
|
FGraph.OnInvalidate:=nil;
|
|
FGraph.OnSelectionChanged:=nil;
|
|
FGraph.OnStructureChanged:=nil;
|
|
FGraph.Free;
|
|
FGraph:=nil;
|
|
FreeAndNil(FLimits);
|
|
FreeAndNil(FEdgeStyle);
|
|
FreeAndNil(FNodeStyle);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.EraseBackground(DC: HDC);
|
|
begin
|
|
// Paint paints all, no need to erase background
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.Clear;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Graph.Clear;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.AutoLayout;
|
|
{ Min/MaxPixelPerWeight: used to scale Node.DrawSize depending on weight of
|
|
incoming and outgoing edges
|
|
NodeGap: space between nodes
|
|
}
|
|
var
|
|
HeaderHeight: integer;
|
|
TxtH: LongInt;
|
|
GapInFront: Integer;
|
|
GapBehind: Integer;
|
|
begin
|
|
//debugln(['TCustomLvlGraphControl.AutoLayout ',DbgSName(Self),' ClientRect=',dbgs(ClientRect)]);
|
|
BeginUpdate;
|
|
try
|
|
Canvas.Font.Assign(Font);
|
|
|
|
DoStartAutoLayout;
|
|
|
|
if HandleAllocated then
|
|
TxtH:=Canvas.TextHeight('M')
|
|
else
|
|
TxtH:=Max(10,abs(Font.Height));
|
|
if Caption<>'' then begin
|
|
HeaderHeight:=round(1.5*TxtH);
|
|
end else
|
|
HeaderHeight:=0;
|
|
|
|
Graph.FindIndependentGraphs;
|
|
|
|
// distribute the nodes on levels and mark back edges
|
|
Graph.CreateTopologicalLevels(lgoHighLevels in Options, lgoReduceBackEdges in Options);
|
|
|
|
Graph.MarkBackEdges;
|
|
|
|
if lgoMinimizeEdgeLens in Options then
|
|
Graph.MinimizeEdgeLens(lgoHighLevels in Options);
|
|
|
|
if (Limits.MaxLevelHeightAbs > 0) or (Limits.MaxLevelHeightRel > 0) then
|
|
Graph.LimitLevelHeights(Limits.MaxLevelHeightAbs, Limits.MaxLevelHeightRel);
|
|
|
|
Graph.SplitLongEdges(EdgeStyle.SplitMode);
|
|
|
|
// permutate nodes within levels to avoid crossings
|
|
DoMinimizeCrossings;
|
|
|
|
// Level DrawPosition
|
|
DoAutoLayoutLevels(TxtH);
|
|
|
|
GapInFront:=NodeStyle.GapTop;
|
|
GapBehind:=NodeStyle.GapBottom;
|
|
case NodeStyle.CaptionPosition of
|
|
lgncTop: GapInFront+=TxtH;
|
|
lgncBottom: GapBehind+=TxtH;
|
|
end;
|
|
|
|
// scale Nodes.DrawSize
|
|
// Preferably the smallest node should be the size of the text
|
|
// Preferably the largest level should fit without needing a scrollbar
|
|
Graph.ScaleNodeDrawSizes(GapInFront,GapBehind,Screen.Height*2,1,
|
|
ClientHeight-HeaderHeight,round(single(TxtH)*NodeStyle.CaptionScale+0.5),
|
|
FPixelPerWeight);
|
|
|
|
// position nodes without overlapping
|
|
DoMinimizeOverlappings(HeaderHeight,GapInFront,GapBehind);
|
|
|
|
if lgoStraightenGraph in Options then
|
|
Graph.StraightenGraph;
|
|
|
|
// node colors
|
|
if NodeStyle.Coloring=lgncRGB then
|
|
ColorNodesRandomRGB;
|
|
|
|
UpdateScrollBars;
|
|
|
|
DoEndAutoLayout;
|
|
|
|
Exclude(FFlags,lgcNeedAutoLayout);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.Invalidate;
|
|
begin
|
|
if lgcIgnoreGraphInvalidate in FFlags then
|
|
exit;
|
|
if fUpdateLock>0 then begin
|
|
Include(FFlags,lgcNeedInvalidate);
|
|
exit;
|
|
end;
|
|
Exclude(FFlags,lgcNeedInvalidate);
|
|
inherited Invalidate;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.InvalidateAutoLayout;
|
|
begin
|
|
if lgoAutoLayout in Options then
|
|
Include(FFlags,lgcNeedAutoLayout);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.BeginUpdate;
|
|
begin
|
|
inc(fUpdateLock);
|
|
end;
|
|
|
|
procedure TCustomLvlGraphControl.EndUpdate;
|
|
begin
|
|
if fUpdateLock=0 then
|
|
raise Exception.Create('');
|
|
dec(fUpdateLock);
|
|
if fUpdateLock=0 then begin
|
|
if [lgcNeedAutoLayout,lgcNeedInvalidate]*FFlags<>[] then
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TCustomLvlGraphControl.GetNodeAt(X, Y: integer): TLvlGraphNode;
|
|
var
|
|
l: Integer;
|
|
Level: TLvlGraphLevel;
|
|
n: Integer;
|
|
Node: TLvlGraphNode;
|
|
begin
|
|
Result:=nil;
|
|
X+=ScrollLeft;
|
|
Y+=ScrollTop;
|
|
// check in reverse painting order
|
|
for l:=Graph.LevelCount-1 downto 0 do begin
|
|
Level:=Graph.Levels[l];
|
|
if (X<Level.DrawPosition) or (X>=Level.DrawPosition+NodeStyle.Width) then continue;
|
|
for n:=Level.Count-1 downto 0 do begin
|
|
Node:=Level.Nodes[n];
|
|
if not Node.Visible then continue;
|
|
if (Y<Node.DrawPosition) or (Y>=Node.DrawPositionEnd) then continue;
|
|
exit(Node);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomLvlGraphControl.GetEdgeAt(X, Y: integer; out Distance: integer
|
|
): TLvlGraphEdge;
|
|
var
|
|
l: Integer;
|
|
Level: TLvlGraphLevel;
|
|
n: Integer;
|
|
Node: TLvlGraphNode;
|
|
e: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
CurDist: Integer;
|
|
r: TRect;
|
|
begin
|
|
Result:=nil;
|
|
Distance:=High(Integer);
|
|
// check in reverse painting order
|
|
for l:=Graph.LevelCount-1 downto 0 do begin
|
|
Level:=Graph.Levels[l];
|
|
for n:=Level.Count-1 downto 0 do begin
|
|
Node:=Level.Nodes[n];
|
|
for e:=Node.OutEdgeCount-1 downto 0 do begin
|
|
Edge:=Node.OutEdges[e];
|
|
r:=Edge.DrawnAt;
|
|
CurDist:=GetDistancePointLine(X,Y,
|
|
r.Left,r.Top,r.Right,r.Bottom);
|
|
if CurDist<Distance then begin
|
|
Result:=Edge;
|
|
Distance:=CurDist;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TCustomLvlGraphControl.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.cx:=200;
|
|
Result.cy:=200;
|
|
end;
|
|
|
|
function TCustomLvlGraphControl.GetDrawSize: TPoint;
|
|
var
|
|
l: Integer;
|
|
Level: TLvlGraphLevel;
|
|
n: Integer;
|
|
Node: TLvlGraphNode;
|
|
x: LongInt;
|
|
CaptionRect: TRect;
|
|
begin
|
|
Result:=Point(0,0);
|
|
for l:=0 to Graph.LevelCount-1 do begin
|
|
Level:=Graph.Levels[l];
|
|
for n:=0 to Level.Count-1 do begin
|
|
Node:=Level[n];
|
|
CaptionRect:=Node.DrawnCaptionRect;
|
|
|
|
Result.Y:=Max(Result.Y,Node.DrawPositionEnd+NodeStyle.GapBottom);
|
|
Result.Y:=Max(Result.Y,CaptionRect.Bottom+ScrollTop);
|
|
|
|
x:=NodeStyle.GapRight;
|
|
if Node.OutEdgeCount>0 then
|
|
x:=Max(x,NodeStyle.Width);
|
|
x+=Level.DrawPosition+NodeStyle.Width;
|
|
Result.X:=Max(Result.X,x);
|
|
Result.X:=Max(Result.X,CaptionRect.Right+ScrollLeft);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
type
|
|
|
|
{ TGraphLevelerNode - used by TLvlGraph.UpdateLevels }
|
|
|
|
TGraphLevelerNode = class
|
|
public
|
|
Node: TLvlGraphNode;
|
|
Level: integer;
|
|
Visited: boolean;
|
|
InPath: boolean; // = node on stack
|
|
end;
|
|
|
|
function CompareGraphLevelerNodes(Node1, Node2: Pointer): integer;
|
|
var
|
|
LNode1: TGraphLevelerNode absolute Node1;
|
|
LNode2: TGraphLevelerNode absolute Node2;
|
|
begin
|
|
Result:=ComparePointer(LNode1.Node,LNode2.Node);
|
|
end;
|
|
|
|
function CompareLGNodeWithLevelerNode(GNode, LNode: Pointer): integer;
|
|
var
|
|
LevelerNode: TGraphLevelerNode absolute LNode;
|
|
begin
|
|
Result:=ComparePointer(GNode,LevelerNode.Node);
|
|
end;
|
|
|
|
{ TLvlGraph }
|
|
|
|
function TLvlGraph.GetNodes(Index: integer): TLvlGraphNode;
|
|
begin
|
|
Result:=TLvlGraphNode(FNodes[Index]);
|
|
end;
|
|
|
|
function TLvlGraph.GetSubGraphCount: integer;
|
|
begin
|
|
Result:=fSubGraphs.Count;
|
|
if Result=0 then begin
|
|
Result:=1;
|
|
TLvlGraphSubGraph.Create(Self,0);
|
|
end;
|
|
end;
|
|
|
|
function TLvlGraph.GetSubGraphs(Index: integer): TLvlGraphSubGraph;
|
|
begin
|
|
if fSubGraphs.Count = 0 then
|
|
GetSubGraphCount;
|
|
Result:=TLvlGraphSubGraph(fSubGraphs[Index]);
|
|
if fSubGraphs.Count=1 then begin
|
|
Result.FLowestLevel:=0;
|
|
Result.FHighestLevel:=LevelCount-1;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.SetLevelCount(AValue: integer);
|
|
begin
|
|
if AValue<1 then
|
|
raise Exception.Create('at least one level');
|
|
if LevelCount=AValue then Exit;
|
|
while LevelCount<AValue do
|
|
FLevelClass.Create(Self,LevelCount);
|
|
while LevelCount>AValue do
|
|
Levels[LevelCount-1].Free;
|
|
end;
|
|
|
|
procedure TLvlGraph.InternalRemoveNode(Node: TLvlGraphNode);
|
|
begin
|
|
FNodes.Remove(Node);
|
|
Node.FGraph:=nil;
|
|
StructureChanged(Node,opRemove);
|
|
end;
|
|
|
|
function TLvlGraph.GetLevels(Index: integer): TLvlGraphLevel;
|
|
begin
|
|
Result:=TLvlGraphLevel(fLevels[Index]);
|
|
end;
|
|
|
|
function TLvlGraph.GetLevelCount: integer;
|
|
begin
|
|
Result:=fLevels.Count;
|
|
end;
|
|
|
|
constructor TLvlGraph.Create;
|
|
begin
|
|
FNodeClass:=TLvlGraphNode;
|
|
FEdgeClass:=TLvlGraphEdge;
|
|
FLevelClass:=TLvlGraphLevel;
|
|
FNodes:=TFPList.Create;
|
|
fLevels:=TFPList.Create;
|
|
fSubGraphs := TFPList.Create;
|
|
end;
|
|
|
|
destructor TLvlGraph.Destroy;
|
|
begin
|
|
Clear;
|
|
FreeAndNil(fSubGraphs);
|
|
FreeAndNil(fLevels);
|
|
FreeAndNil(FNodes);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLvlGraph.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
while NodeCount>0 do
|
|
Nodes[NodeCount-1].Free;
|
|
for i:=LevelCount-1 downto 0 do
|
|
Levels[i].Free;
|
|
for i:=fSubGraphs.Count-1 downto 0 do
|
|
TLvlGraphSubGraph(fSubGraphs[i]).Free;
|
|
end;
|
|
|
|
procedure TLvlGraph.Invalidate;
|
|
begin
|
|
if OnInvalidate<>nil then
|
|
OnInvalidate(Self);
|
|
end;
|
|
|
|
procedure TLvlGraph.StructureChanged(Element: TObject; Operation: TOperation);
|
|
begin
|
|
if Assigned(OnStructureChanged) then
|
|
OnStructureChanged(Self,Element,Operation);
|
|
end;
|
|
|
|
function TLvlGraph.NodeCount: integer;
|
|
begin
|
|
Result:=FNodes.Count;
|
|
end;
|
|
|
|
function TLvlGraph.GetNode(aCaption: string; CreateIfNotExists: boolean
|
|
): TLvlGraphNode;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=NodeCount-1;
|
|
if FCaseSensitive then
|
|
while (i>=0) and (aCaption<>Nodes[i].Caption) do dec(i)
|
|
else
|
|
while (i>=0) and not SameText(aCaption, Nodes[i].Caption) do dec(i);
|
|
|
|
if i>=0 then begin
|
|
Result:=Nodes[i];
|
|
end else if CreateIfNotExists then begin
|
|
if LevelCount=0 then
|
|
LevelCount:=1;
|
|
Result:=FNodeClass.Create(Self,aCaption,Levels[0]);
|
|
FNodes.Add(Result);
|
|
StructureChanged(Result,opInsert);
|
|
end else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TLvlGraph.CreateHiddenNode(Level: integer): TLvlGraphNode;
|
|
begin
|
|
Result:=FNodeClass.Create(Self,'',Levels[Level]);
|
|
Result.Visible:=false;
|
|
FNodes.Add(Result);
|
|
StructureChanged(Result,opInsert);
|
|
end;
|
|
|
|
procedure TLvlGraph.ClearSelection;
|
|
begin
|
|
while FirstSelected<>nil do
|
|
FirstSelected.Selected:=false;
|
|
end;
|
|
|
|
procedure TLvlGraph.SingleSelect(Node: TLvlGraphNode);
|
|
begin
|
|
if (Node=FirstSelected) and (Node.NextSelected=nil) then exit;
|
|
Node.Selected:=true;
|
|
while FirstSelected<>Node do
|
|
FirstSelected.Selected:=false;
|
|
while LastSelected<>Node do
|
|
LastSelected.Selected:=false;
|
|
end;
|
|
|
|
function TLvlGraph.IsMultiSelection: boolean;
|
|
begin
|
|
Result:=(FirstSelected<>nil) and (FirstSelected.NextSelected<>nil);
|
|
end;
|
|
|
|
function TLvlGraph.GetEdge(SourceCaption, TargetCaption: string;
|
|
CreateIfNotExists: boolean): TLvlGraphEdge;
|
|
var
|
|
Source: TLvlGraphNode;
|
|
Target: TLvlGraphNode;
|
|
begin
|
|
Source:=GetNode(SourceCaption,CreateIfNotExists);
|
|
if Source=nil then exit(nil);
|
|
Target:=GetNode(TargetCaption,CreateIfNotExists);
|
|
if Target=nil then exit(nil);
|
|
Result:=GetEdge(Source,Target,CreateIfNotExists);
|
|
end;
|
|
|
|
function TLvlGraph.GetEdge(Source, Target: TLvlGraphNode;
|
|
CreateIfNotExists: boolean): TLvlGraphEdge;
|
|
begin
|
|
Result:=Source.FindOutEdge(Target);
|
|
if Result<>nil then exit;
|
|
if CreateIfNotExists then begin
|
|
Result:=FEdgeClass.Create(Source,Target);
|
|
StructureChanged(Result,opInsert);
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.FindIndependentGraphs;
|
|
procedure ApplySubGraphRecursively(Node: TLvlGraphNode; SubGraph: integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
assert((node.SubGraph < 0) or (Node.SubGraph = SubGraph), 'ApplySubGraphRecursively: node already in other subgraph');
|
|
if Node.SubGraph >= 0 then
|
|
exit;
|
|
node.SubGraph := SubGraph;
|
|
for i := 0 to node.InEdgeCount - 1 do
|
|
ApplySubGraphRecursively(Node.InEdges[i].Source, SubGraph);
|
|
for i := 0 to node.OutEdgeCount - 1 do
|
|
ApplySubGraphRecursively(Node.OutEdges[i].Target, SubGraph);
|
|
end;
|
|
var
|
|
i: Integer;
|
|
Node: TLvlGraphNode;
|
|
CurrentSubGraph: TLvlGraphSubGraph;
|
|
begin
|
|
CurrentSubGraph := SubGraphs[0];
|
|
for i:=0 to NodeCount-1 do
|
|
Nodes[i].FSubGraph := -1;
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node := Nodes[i];
|
|
if Node.SubGraph >= 0 then Continue;
|
|
if CurrentSubGraph = nil then
|
|
CurrentSubGraph:=TLvlGraphSubGraph.Create(Self, SubGraphCount);
|
|
ApplySubGraphRecursively(Node, CurrentSubGraph.Index);
|
|
CurrentSubGraph := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.InternalRemoveLevel(Lvl: TLvlGraphLevel);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Levels[Lvl.Index]<>Lvl then
|
|
raise Exception.Create('inconsistency');
|
|
fLevels.Delete(Lvl.Index);
|
|
// update level Index
|
|
for i:=Lvl.Index to LevelCount-1 do
|
|
Levels[i].FIndex:=i;
|
|
StructureChanged(Lvl,opRemove);
|
|
end;
|
|
|
|
procedure TLvlGraph.SelectionChanged;
|
|
begin
|
|
Invalidate;
|
|
if OnSelectionChanged<>nil then
|
|
OnSelectionChanged(Self);
|
|
end;
|
|
|
|
function TLvlGraph.NewLevelAtIndex(AnIndex, ASubGraphIndex: integer
|
|
): TLvlGraphLevel;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := FLevelClass.Create(Self,AnIndex);
|
|
SubGraphs[ASubGraphIndex].FHighestLevel := SubGraphs[ASubGraphIndex].HighestLevel + 1;
|
|
for i := ASubGraphIndex+1 to SubGraphCount - 1 do begin
|
|
SubGraphs[i].FLowestLevel := SubGraphs[i].LowestLevel + 1;
|
|
SubGraphs[i].FHighestLevel := SubGraphs[i].HighestLevel + 1;
|
|
end
|
|
end;
|
|
|
|
procedure TLvlGraph.CreateTopologicalLevels(HighLevels, ReduceBackEdges: boolean);
|
|
var
|
|
ExtNodes: TAvlTree; // tree of TGraphLevelerNode sorted by Node
|
|
MaxLevel: Integer;
|
|
|
|
function GetExtNode(Node: TLvlGraphNode): TGraphLevelerNode;
|
|
begin
|
|
Result:=TGraphLevelerNode(ExtNodes.FindKey(Pointer(Node),@CompareLGNodeWithLevelerNode).Data);
|
|
end;
|
|
|
|
procedure Traverse(ExtNode: TGraphLevelerNode; MinLevel: Integer);
|
|
var
|
|
Node: TLvlGraphNode;
|
|
e: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
ExtNextNode: TGraphLevelerNode;
|
|
Cnt: Integer;
|
|
begin
|
|
if ExtNode.Visited then exit;
|
|
ExtNode.InPath:=true;
|
|
ExtNode.Visited:=true;
|
|
if ExtNode.Level < MinLevel then
|
|
ExtNode.Level := MinLevel;
|
|
Node:=ExtNode.Node;
|
|
if HighLevels then
|
|
Cnt:=Node.OutEdgeCount
|
|
else
|
|
Cnt:=Node.InEdgeCount;
|
|
for e:=0 to Cnt-1 do begin
|
|
if HighLevels then begin
|
|
Edge:=Node.OutEdges[e];
|
|
ExtNextNode:=GetExtNode(Edge.Target);
|
|
end else begin
|
|
Edge:=Node.InEdges[e];
|
|
ExtNextNode:=GetExtNode(Edge.Source);
|
|
end;
|
|
if not ExtNextNode.InPath then begin
|
|
Traverse(ExtNextNode, MinLevel);
|
|
ExtNode.Level:=Max(ExtNode.Level,ExtNextNode.Level+1);
|
|
end;
|
|
// else node is part of a cycle
|
|
end;
|
|
MaxLevel:=Max(MaxLevel,ExtNode.Level);
|
|
// backtrack
|
|
ExtNode.InPath:=false;
|
|
end;
|
|
|
|
procedure DoReduceBackEdges(var MaxLevel: integer; StartLevel, SubGraphIdx: integer);
|
|
var
|
|
MaybeReduceMaxLevel: Boolean;
|
|
|
|
function IncomingBackEdgeCount(ExtReceivingNode: TGraphLevelerNode;
|
|
PretendLevel: Integer; out HasSiblingOnPretendLevel: Boolean;
|
|
out NextLowelSiblingAtLevel: integer): integer;
|
|
var
|
|
Node: TLvlGraphNode;
|
|
i, c: Integer;
|
|
ExtFromNode: TGraphLevelerNode;
|
|
begin
|
|
Result := 0;
|
|
HasSiblingOnPretendLevel := False;
|
|
NextLowelSiblingAtLevel := StartLevel-1;
|
|
Node := ExtReceivingNode.Node;
|
|
if HighLevels then
|
|
c := Node.OutEdgeCount
|
|
else
|
|
c := Node.InEdgeCount;
|
|
for i := 0 to c - 1 do begin
|
|
if HighLevels then
|
|
ExtFromNode := GetExtNode(Node.OutEdges[i].Target)
|
|
else
|
|
ExtFromNode := GetExtNode(Node.InEdges[i].Source);
|
|
if ExtFromNode.Level >= PretendLevel then // include equal => they will need to be pushed up, if the node is inserted at this level
|
|
inc(Result);
|
|
if ExtFromNode.Level = PretendLevel then
|
|
HasSiblingOnPretendLevel := True
|
|
else
|
|
if (ExtFromNode.Level > NextLowelSiblingAtLevel) and (ExtFromNode.Level < PretendLevel) then
|
|
NextLowelSiblingAtLevel := ExtFromNode.Level;
|
|
end;
|
|
end;
|
|
procedure AdjustSiblingLevels(ExtAdjustNode: TGraphLevelerNode; NewLevel: integer; Force: Boolean = False);
|
|
var
|
|
i, c, OldLevel: Integer;
|
|
ExtSiblingNode: TGraphLevelerNode;
|
|
Node: TLvlGraphNode;
|
|
begin
|
|
if ExtAdjustNode.InPath then
|
|
exit;
|
|
ExtAdjustNode.InPath := True;
|
|
|
|
if (ExtAdjustNode.Level > NewLevel) and not force then begin
|
|
Node := ExtAdjustNode.Node;
|
|
if HighLevels then
|
|
c := Node.OutEdgeCount
|
|
else
|
|
c := Node.InEdgeCount;
|
|
for i := 0 to c - 1 do begin
|
|
if HighLevels then
|
|
ExtSiblingNode := GetExtNode(Node.OutEdges[i].Target)
|
|
else
|
|
ExtSiblingNode := GetExtNode(Node.InEdges[i].Source);
|
|
if (ExtSiblingNode.Level >= NewLevel) and (ExtSiblingNode.Level < ExtAdjustNode.Level) then
|
|
NewLevel := ExtSiblingNode.Level + 1;
|
|
end;
|
|
if HighLevels then
|
|
c := Node.InEdgeCount
|
|
else
|
|
c := Node.OutEdgeCount;
|
|
// check backlinks
|
|
for i := 0 to c - 1 do begin
|
|
if HighLevels then
|
|
ExtSiblingNode := GetExtNode(Node.InEdges[i].Source)
|
|
else
|
|
ExtSiblingNode := GetExtNode(Node.OutEdges[i].Target);
|
|
if (ExtSiblingNode.Level = NewLevel) then
|
|
NewLevel := ExtSiblingNode.Level + 1;
|
|
end;
|
|
end;
|
|
|
|
if (ExtAdjustNode.Level = NewLevel) and not Force then begin
|
|
ExtAdjustNode.InPath := False;
|
|
exit;
|
|
end;
|
|
|
|
OldLevel := ExtAdjustNode.Level;
|
|
ExtAdjustNode.Level := NewLevel;
|
|
if NewLevel > MaxLevel then
|
|
MaxLevel := NewLevel;
|
|
if OldLevel = MaxLevel then
|
|
MaybeReduceMaxLevel := True;
|
|
|
|
Node := ExtAdjustNode.Node;
|
|
if HighLevels then
|
|
c := Node.InEdgeCount
|
|
else
|
|
c := Node.OutEdgeCount;
|
|
for i := 0 to c - 1 do begin
|
|
if HighLevels then
|
|
ExtSiblingNode := GetExtNode(Node.InEdges[i].Source)
|
|
else
|
|
ExtSiblingNode := GetExtNode(Node.OutEdges[i].Target);
|
|
if ExtSiblingNode.Level >= OldLevel then // do not adjust other BackEdges
|
|
AdjustSiblingLevels(ExtSiblingNode, NewLevel + 1);
|
|
end;
|
|
// maybe new backegdes on the InEdge side
|
|
if HighLevels then
|
|
c := Node.OutEdgeCount
|
|
else
|
|
c := Node.InEdgeCount;
|
|
for i := 0 to c - 1 do begin
|
|
if HighLevels then
|
|
ExtSiblingNode := GetExtNode(Node.OutEdges[i].Target)
|
|
else
|
|
ExtSiblingNode := GetExtNode(Node.InEdges[i].Source);
|
|
if ExtSiblingNode.Level = NewLevel then // do not adjust other BackEdges
|
|
AdjustSiblingLevels(ExtSiblingNode, NewLevel + 1);
|
|
end;
|
|
|
|
ExtAdjustNode.InPath := False;
|
|
end;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
ExtNode, ExtTargetNode: TGraphLevelerNode;
|
|
Node: TLvlGraphNode;
|
|
LvlIdx, LowerLvl, BackEdgeCnt, TotalBackEdgeCnt: Integer;
|
|
i, c, j, BestLvl: integer;
|
|
BackEdgeList: array of TGraphLevelerNode;
|
|
SiblingOnLvl: Boolean;
|
|
begin
|
|
SetLength(BackEdgeList, NodeCount);
|
|
MaybeReduceMaxLevel := False;
|
|
AVLNode := ExtNodes.FindLowest;
|
|
while AVLNode <> nil do begin
|
|
ExtNode := TGraphLevelerNode(AVLNode.Data);
|
|
AVLNode := AVLNode.Successor;
|
|
Node := ExtNode.Node;
|
|
if (Node.SubGraph <> SubGraphIdx) then
|
|
Continue;
|
|
|
|
BackEdgeCnt := 0;
|
|
if HighLevels then
|
|
c := Node.InEdgeCount
|
|
else
|
|
c := Node.OutEdgeCount;
|
|
if c > Length(BackEdgeList) then
|
|
SetLength(BackEdgeList, c);
|
|
LvlIdx := ExtNode.Level;
|
|
for i := 0 to c - 1 do begin
|
|
if HighLevels then
|
|
ExtTargetNode := GetExtNode(Node.InEdges[i].Source)
|
|
else
|
|
ExtTargetNode := GetExtNode(Node.OutEdges[i].Target);
|
|
if ExtTargetNode.Level < LvlIdx then begin
|
|
j := 0;
|
|
while (j < BackEdgeCnt) and (BackEdgeList[j].Level < ExtTargetNode.Level) do
|
|
inc(j);
|
|
move(BackEdgeList[j], BackEdgeList[j+1], (BackEdgeCnt-j)*SizeOf(TGraphLevelerNode));
|
|
BackEdgeList[j] := ExtTargetNode;
|
|
inc(BackEdgeCnt);
|
|
end;
|
|
end;
|
|
if BackEdgeCnt = 0 then
|
|
Continue;
|
|
|
|
BestLvl := ExtNode.Level;
|
|
TotalBackEdgeCnt := BackEdgeCnt + IncomingBackEdgeCount(ExtNode, BestLvl, SiblingOnLvl, LowerLvl);
|
|
BestLvl := LowerLvl + 1;
|
|
while BackEdgeCnt > 0 do begin
|
|
dec(BackEdgeCnt);
|
|
i := BackEdgeList[BackEdgeCnt].Level;
|
|
while (BackEdgeCnt > 0) and (BackEdgeList[BackEdgeCnt - 1].Level = i) do
|
|
dec(BackEdgeCnt);
|
|
c := BackEdgeCnt + IncomingBackEdgeCount(ExtNode, i, SiblingOnLvl, LowerLvl);
|
|
if c < TotalBackEdgeCnt then begin
|
|
BestLvl := LowerLvl + 1;
|
|
TotalBackEdgeCnt := c;
|
|
end;
|
|
end;
|
|
|
|
if BestLvl < ExtNode.Level then begin
|
|
ExtNode.Level := BestLvl;
|
|
AdjustSiblingLevels(ExtNode, BestLvl, True);
|
|
end;
|
|
|
|
end;
|
|
|
|
if MaybeReduceMaxLevel then begin
|
|
MaxLevel := StartLevel;
|
|
AVLNode := ExtNodes.FindLowest;
|
|
while AVLNode <> nil do begin
|
|
ExtNode := TGraphLevelerNode(AVLNode.Data);
|
|
AVLNode := AVLNode.Successor;
|
|
if ExtNode.Node.SubGraph <> SubGraphIdx then
|
|
continue;
|
|
if ExtNode.Level > MaxLevel then
|
|
MaxLevel := ExtNode.Level;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i, g, GroupMinLevel: Integer;
|
|
Node: TLvlGraphNode;
|
|
ExtNode: TGraphLevelerNode;
|
|
CurrentSubGraph: TLvlGraphSubGraph;
|
|
begin
|
|
//WriteDebugReport('TLvlGraph.CreateTopologicalLevels START');
|
|
{$IFDEF LvlGraphConsistencyCheck}
|
|
ConsistencyCheck(false);
|
|
{$ENDIF}
|
|
ExtNodes:=TAvlTree.Create(@CompareGraphLevelerNodes);
|
|
try
|
|
// init ExtNodes
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node:=Nodes[i];
|
|
ExtNode:=TGraphLevelerNode.Create;
|
|
ExtNode.Node:=Node;
|
|
ExtNodes.Add(ExtNode);
|
|
end;
|
|
// traverse all nodes
|
|
MaxLevel:=-1;
|
|
for g := 0 to SubGraphCount - 1 do begin
|
|
inc(MaxLevel);
|
|
CurrentSubGraph := SubGraphs[g];
|
|
CurrentSubGraph.FLowestLevel := MaxLevel;
|
|
GroupMinLevel := MaxLevel;
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node:=Nodes[i];
|
|
if (Node.SubGraph <> CurrentSubGraph.Index) then
|
|
Continue;
|
|
Traverse(GetExtNode(Node), GroupMinLevel);
|
|
end;
|
|
|
|
if ReduceBackEdges then
|
|
DoReduceBackEdges(MaxLevel, CurrentSubGraph.FLowestLevel, CurrentSubGraph.Index);
|
|
CurrentSubGraph.FHighestLevel := MaxLevel;
|
|
end;
|
|
|
|
// set levels
|
|
LevelCount:=Max(LevelCount,MaxLevel+1);
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node:=Nodes[i];
|
|
ExtNode:=GetExtNode(Node);
|
|
if HighLevels then begin
|
|
CurrentSubGraph := SubGraphs[ExtNode.Node.SubGraph];
|
|
Node.Level:=Levels[CurrentSubGraph.LowestLevel + CurrentSubGraph.HighestLevel - ExtNode.Level];
|
|
end
|
|
else
|
|
Node.Level:=Levels[ExtNode.Level];
|
|
end;
|
|
// delete unneeded levels
|
|
LevelCount:=MaxLevel+1;
|
|
finally
|
|
ExtNodes.FreeAndClear;
|
|
ExtNodes.Free;
|
|
end;
|
|
//WriteDebugReport('TLvlGraph.CreateTopologicalLevels END');
|
|
{$IFDEF LvlGraphConsistencyCheck}
|
|
ConsistencyCheck(False);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TLvlGraph.MinimizeEdgeLens(HighLevels: boolean);
|
|
(* This method can only minize edges in certain graphs.
|
|
Therefore some edges may not be fully minimized.
|
|
|
|
Possible TODOs
|
|
* gelOnlyPush:
|
|
- For Edges with len>1, check if the target node is reachable via len=1 nodes.
|
|
If yes the edge cannot be shortened
|
|
- Collect all InEntries for each entire group, so that CalculateCostForMoveUp can
|
|
calculate the cost for the entire group at once.
|
|
* Check for nodes in front of the current node, that are free to pull up.
|
|
If a node has several InEdges, they may prevent it from moving.
|
|
And in turn the node itself may prevent any of those sources from moving.
|
|
*)
|
|
var
|
|
NodeTree: TGraphEdgeLenMinimizerTree; // tree of TGraphEdgeLenMinimizerNode sorted by Node
|
|
VisitingId: Integer;
|
|
|
|
procedure UpdateMaxLevelsForSiblings(ExtNode: TGraphEdgeLenMinimizerNode);
|
|
var
|
|
i: Integer;
|
|
Sibling: TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
for i := 0 to ExtNode.InSiblingCount - 1 do begin
|
|
Sibling := ExtNode.InSibling[i];
|
|
Sibling.MaxLevel := Min(Sibling.MaxLevel, ExtNode.MaxLevel-1);
|
|
Assert(Sibling.MaxLevel >= Sibling.Level, 'UpdateMaxLevelsForSiblings: Sibling.MinLevel <= Sibling.Level');
|
|
Assert(Sibling.Level < ExtNode.Level, 'UpdateMaxLevelsForSiblings: Sibling.Level > ExtNode.Level');
|
|
end;
|
|
end;
|
|
|
|
procedure MaybeMarkOnlyPush(ExtNode: TGraphEdgeLenMinimizerNode);
|
|
var
|
|
i: Integer;
|
|
Sibling: TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
for i := 0 to ExtNode.OutSiblingCount - 1 do begin
|
|
if ExtNode.OutSiblingDistance[i] > 1 then exit;
|
|
Sibling := ExtNode.OutSibling[i];
|
|
assert(Sibling.Level - ExtNode.Level = 1, 'MaybeMarkOnlyPush: Dist = 1');
|
|
if not (gelOnlyPush in Sibling.Flags) then exit;
|
|
end;
|
|
Include(ExtNode.Flags, gelOnlyPush);
|
|
end;
|
|
|
|
function CalculateCostForMoveUp(CalcExtNode: TGraphEdgeLenMinimizerNode; var CalcNewLevel: Integer): Integer;
|
|
function CheckInEdgeSavingsQuick(InEdgeExtNode: TGraphEdgeLenMinimizerNode; MaxSavingNeeded: Integer): Integer;
|
|
var
|
|
i, j, l, d, SiblingCanSave: Integer;
|
|
InSibling, ReverseSibling: TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Result := 0;
|
|
l := InEdgeExtNode.Level - 1;
|
|
for i := 0 to InEdgeExtNode.InSiblingCount - 1 do begin
|
|
InSibling := InEdgeExtNode.InSibling[i];
|
|
SiblingCanSave := 0;
|
|
if InSibling.Level < l then
|
|
continue;
|
|
if InSibling.InSiblingCount >= InSibling.OutSiblingCount-1 then
|
|
continue;
|
|
for j := 0 to InSibling.OutSiblingCount - 1 do begin
|
|
ReverseSibling := InSibling.OutSibling[j];
|
|
d := ReverseSibling.Level - InSibling.Level;
|
|
if (ReverseSibling = InEdgeExtNode) then
|
|
continue;
|
|
if d <= 1 then
|
|
break;
|
|
if d < MaxSavingNeeded then
|
|
MaxSavingNeeded := d;
|
|
end;
|
|
if (d <= 1) and (ReverseSibling <> InEdgeExtNode) then begin // loop aborted
|
|
continue;
|
|
end;
|
|
for j := 0 to InSibling.OutSiblingCount - 1 do begin
|
|
ReverseSibling := InSibling.OutSibling[j];
|
|
if (ReverseSibling = InEdgeExtNode) then
|
|
continue;
|
|
d := ReverseSibling.Level - InSibling.Level;
|
|
SiblingCanSave := SiblingCanSave + Min(MaxSavingNeeded, d);
|
|
end;
|
|
SiblingCanSave := SiblingCanSave - InSibling.InSiblingCount;
|
|
Result := Result + max(0, SiblingCanSave);
|
|
end;
|
|
end;
|
|
procedure SetNewLevelDiffRecursive(TargetExtNode: TGraphEdgeLenMinimizerNode; TargetNewLevel: Integer;
|
|
out CostChangesAtLevel: integer);
|
|
var
|
|
Diff, i, SiblingCostChangesAtLevel: Integer;
|
|
FirstMove: Boolean;
|
|
SiblingNode: TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Assert(TargetNewLevel <= TargetExtNode.MaxLevel, 'CalculateCostForMoveUp(): TargetNewLevel < MaxLevel');
|
|
Assert(TargetNewLevel < LevelCount, 'CalculateCostForMoveUp(): TargetNewLevel < LevelCount');
|
|
CostChangesAtLevel := TargetExtNode.Level + 1; // Applies, if this node is NOT pushed
|
|
Diff := TargetNewLevel - TargetExtNode.Level;
|
|
FirstMove := TargetExtNode.VisitedId <> VisitingId; // The same node may be pushed several times, if more than one edge leads here
|
|
TargetExtNode.VisitedId := VisitingId;
|
|
if FirstMove then
|
|
TargetExtNode.LevelDiff := 0
|
|
else
|
|
CostChangesAtLevel := TargetExtNode.MaxLevel+1; // correct limit has been applied before / in case next line does exit
|
|
if Diff <= TargetExtNode.LevelDiff then
|
|
exit;
|
|
TargetExtNode.LevelDiff := Diff;
|
|
CostChangesAtLevel := TargetExtNode.MaxLevel+1; // Best case we can go to MaxLevel, then cost goes to infinite
|
|
if (TargetExtNode.InSiblingCount > 1) then // One InEdge is from the pushing node
|
|
CostChangesAtLevel := TargetExtNode.Level + Diff + 1; // could be more, if the nodes can be pulled free of cost
|
|
for i := 0 to TargetExtNode.InSiblingCount - 1 do begin
|
|
SiblingNode := TargetExtNode.InSibling[i];
|
|
if SiblingNode.VisitedId <> VisitingId then
|
|
SiblingNode.LevelDiff := 0;
|
|
end;
|
|
for i := 0 to TargetExtNode.OutSiblingCount - 1 do begin
|
|
SiblingNode := TargetExtNode.OutSibling[i];
|
|
SetNewLevelDiffRecursive(SiblingNode, TargetNewLevel + 1, SiblingCostChangesAtLevel);
|
|
if SiblingCostChangesAtLevel - 1 < CostChangesAtLevel then
|
|
CostChangesAtLevel := SiblingCostChangesAtLevel - 1;
|
|
end;
|
|
end;
|
|
function DoCalculateCostForMoveUp(ExtNode: TGraphEdgeLenMinimizerNode): Integer;
|
|
var
|
|
i: Integer;
|
|
SiblingNode: TGraphEdgeLenMinimizerNode;
|
|
begin
|
|
Result := 0;
|
|
if (ExtNode.VisitedId = VisitingId) or (ExtNode.LevelDiff = 0) then
|
|
exit;
|
|
ExtNode.VisitedId := VisitingId;
|
|
// InEdges get longer
|
|
for i := 0 to ExtNode.InSiblingCount - 1 do
|
|
Result := Result + ExtNode.LevelDiff - ExtNode.InSibling[i].LevelDiff;
|
|
for i := 0 to ExtNode.OutSiblingCount - 1 do begin
|
|
SiblingNode := ExtNode.OutSibling[i];
|
|
Result := Result - ExtNode.LevelDiff + SiblingNode.LevelDiff;
|
|
Result := Result + DoCalculateCostForMoveUp(SiblingNode);
|
|
end;
|
|
end;
|
|
var
|
|
NextCostChangesAtLevel, i: Integer;
|
|
begin
|
|
inc(VisitingId);
|
|
SetNewLevelDiffRecursive(CalcExtNode, CalcNewLevel, NextCostChangesAtLevel);
|
|
dec(NextCostChangesAtLevel); // the last level use-able without extra cost
|
|
Assert(NextCostChangesAtLevel <= CalcExtNode.MaxLevel, 'CalculateCostForMoveUp: NextCostChangesAtLevel <= CalcExtNode.MaxLevel');
|
|
Assert(NextCostChangesAtLevel >= CalcNewLevel, 'CalculateCostForMoveUp: NextCostChangesAtLevel >= CalcNewLevel');
|
|
if (NextCostChangesAtLevel > CalcNewLevel) and (NextCostChangesAtLevel <= CalcExtNode.MaxLevel) then begin
|
|
CalcNewLevel := NextCostChangesAtLevel;
|
|
inc(VisitingId);
|
|
SetNewLevelDiffRecursive(CalcExtNode, CalcNewLevel, NextCostChangesAtLevel);
|
|
end;
|
|
inc(VisitingId);
|
|
Result := DoCalculateCostForMoveUp(CalcExtNode);
|
|
if Result >= 0 then
|
|
Result := Result - CheckInEdgeSavingsQuick(CalcExtNode, CalcNewLevel - CalcExtNode.Level)
|
|
else
|
|
if Result = 0 then begin
|
|
inc(Result); // zero cost should be moved only, if it might block on of its InEdges
|
|
for i := 0 to CalcExtNode.InSiblingCount - 1 do begin
|
|
if CalcExtNode.InSibling[i].Level = CalcExtNode.Level - 1 then begin
|
|
dec(Result); // return 0 => at least one node that might be blocked
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure PushLevelUpRecursive(ExtNode: TGraphEdgeLenMinimizerNode; NewLevel: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Assert(NewLevel < LevelCount, 'PushLevelUpRecursive: NewLevel < LevelCount');
|
|
if ExtNode.Level >= NewLevel then
|
|
exit;
|
|
ExtNode.Level:=NewLevel;
|
|
|
|
for i := 0 to ExtNode.OutSiblingCount - 1 do
|
|
PushLevelUpRecursive(ExtNode.OutSibling[i], NewLevel + 1);
|
|
end;
|
|
|
|
function TryMoveNode(ExtNode: TGraphEdgeLenMinimizerNode): boolean;
|
|
var
|
|
BestCost, ConsecutiveBadCost, Cost, BestLvl, i, mx: Integer;
|
|
begin
|
|
Result := False;
|
|
BestCost := 0;
|
|
ConsecutiveBadCost := 0;
|
|
|
|
mx := ExtNode.MaxLevel-1;
|
|
i := ExtNode.Level;
|
|
while i < mx do begin
|
|
inc(i);
|
|
Cost := CalculateCostForMoveUp(ExtNode, i);
|
|
if Cost > 0 then begin
|
|
ConsecutiveBadCost := ConsecutiveBadCost + 1;
|
|
if ConsecutiveBadCost >= 3 then
|
|
break; // give up
|
|
end
|
|
else
|
|
if Cost <= BestCost then begin
|
|
ConsecutiveBadCost := 0;
|
|
BestCost := Cost;
|
|
BestLvl := i;
|
|
end;
|
|
end;
|
|
|
|
inc(mx);
|
|
Cost := CalculateCostForMoveUp(ExtNode, mx);
|
|
if Cost <= BestCost then begin
|
|
BestCost := Cost;
|
|
BestLvl := mx;
|
|
end;
|
|
|
|
//DebugLn([' BestCost: ',ExtNode.Node.Caption, ' from ', ExtNode.Level, ' to idx ', BestLvl,' (', ExtNode.Level+1 ,'..', ExtNode.MaxLevel,') cost ', BestCost ]);
|
|
Result := BestCost < 0;
|
|
if Result then
|
|
PushLevelUpRecursive(ExtNode, BestLvl);
|
|
end;
|
|
|
|
var
|
|
i, l, j: Integer;
|
|
ExtNode: TGraphEdgeLenMinimizerNode;
|
|
DidMove: Boolean;
|
|
CurrentSubGraph: TLvlGraphSubGraph;
|
|
begin
|
|
NodeTree:=TGraphEdgeLenMinimizerTree.Create;
|
|
NodeTree.Graph:=Self;
|
|
VisitingId := 0;
|
|
if HighLevels then
|
|
NodeTree.NodeClass := TGraphEdgeLenMinimizerReverseNode;
|
|
|
|
try
|
|
// init NodeTree // Add highest level first, so nodes can be linked in initial order
|
|
for j := LevelCount-1 downto 0 do begin
|
|
l := NodeTree.MapLevel(j);
|
|
for i := 0 to Levels[l].Count - 1 do begin
|
|
ExtNode := NodeTree.AddGraphNode(Levels[l].Nodes[i]);
|
|
CurrentSubGraph := SubGraphs[ExtNode.Node.SubGraph];
|
|
ExtNode.MaxLevel := CurrentSubGraph.HighestLevel;
|
|
ExtNode.MinSubGraphLevel := CurrentSubGraph.LowestLevel;
|
|
ExtNode.MaxSubGraphLevel := CurrentSubGraph.HighestLevel;
|
|
end;
|
|
end;
|
|
|
|
// Update MaxLevel
|
|
ExtNode := NodeTree.ExtNodeWithHighestLevel;
|
|
while ExtNode <> nil do begin
|
|
UpdateMaxLevelsForSiblings(ExtNode);
|
|
ExtNode := ExtNode.NextExtNodeTowardsLowerLevel;
|
|
end;
|
|
|
|
// gelOnlyPush: Mark nodes, with no outgoing edges that could be shortened (push would push entire subtree)
|
|
ExtNode := NodeTree.ExtNodeWithHighestLevel;
|
|
while ExtNode <> nil do begin
|
|
if ExtNode.MaxLevel > ExtNode.Level then
|
|
MaybeMarkOnlyPush(ExtNode);
|
|
ExtNode := ExtNode.NextExtNodeTowardsLowerLevel;
|
|
end;
|
|
|
|
repeat
|
|
DidMove := False;
|
|
ExtNode := TGraphEdgeLenMinimizerNode(NodeTree.FindLowest);
|
|
while ExtNode<> nil do begin
|
|
if (ExtNode.OutSiblingCount > 0) and (ExtNode.MaxLevel > ExtNode.Level) and
|
|
not(gelOnlyPush in ExtNode.Flags)
|
|
then
|
|
if TryMoveNode(ExtNode) then
|
|
DidMove := True;
|
|
ExtNode := TGraphEdgeLenMinimizerNode(ExtNode.Successor);
|
|
end;
|
|
until not DidMove;
|
|
|
|
finally
|
|
NodeTree.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.LimitLevelHeights(MaxHeight: integer; MaxHeightRel: Single);
|
|
var
|
|
SubGraphIdx, LowLevelIdx, HighLevelIdx, CurLevelIdx: Integer;
|
|
CurNodeCount, CurMaxHeight: Integer;
|
|
i, j, w, LevelsNeeded, TargetLvlCnt: Integer;
|
|
CurLevel: TLvlGraphLevel;
|
|
CurNode: TLvlGraphNode;
|
|
NodeWeights: array of record
|
|
Node: TLvlGraphNode;
|
|
Weight: integer;
|
|
end;
|
|
CurrentSubGraph: TLvlGraphSubGraph;
|
|
begin
|
|
if LevelCount = 0 then
|
|
exit;
|
|
NodeWeights := nil;
|
|
For SubGraphIdx := 0 to SubGraphCount-1 do begin
|
|
CurrentSubGraph := SubGraphs[SubGraphIdx];
|
|
//For SubGraphIdx := 0 to Max(0, FSubGraphCount-1) do begin
|
|
// Find Lowest/Highest level for subgraph
|
|
LowLevelIdx := CurrentSubGraph.LowestLevel;
|
|
HighLevelIdx := CurrentSubGraph.HighestLevel;
|
|
CurNodeCount := 0;
|
|
for i := LowLevelIdx to HighLevelIdx do
|
|
CurNodeCount := CurNodeCount + Levels[i].Count;
|
|
|
|
// Calculate CurMaxHeight for SubGraph
|
|
if MaxHeightRel > 0 then begin
|
|
if MaxHeight > 0 then
|
|
CurMaxHeight := Min(MaxHeight, Max(3, Trunc(0.5 + sqrt(CurNodeCount)*MaxHeightRel)))
|
|
else
|
|
CurMaxHeight := Max(3, Trunc(0.5 + sqrt(CurNodeCount)*MaxHeightRel));
|
|
end
|
|
else
|
|
CurMaxHeight := MaxHeight;
|
|
if CurMaxHeight <= 0 then Continue;
|
|
|
|
// Process each level
|
|
CurLevelIdx := HighLevelIdx + 1;
|
|
while CurLevelIdx > LowLevelIdx do begin
|
|
dec(CurLevelIdx);
|
|
CurLevel := Levels[CurLevelIdx];
|
|
if CurLevel.Count <= CurMaxHeight then
|
|
continue;
|
|
|
|
if Length(NodeWeights) < CurLevel.Count then
|
|
SetLength(NodeWeights, CurLevel.Count + 8);
|
|
|
|
for i := 0 to CurLevel.Count - 1 do begin
|
|
CurNode := CurLevel.Nodes[i];
|
|
if CurNode.InEdgeCount = 0 then
|
|
w := CurNodeCount * CurNode.OutEdgeCount
|
|
else
|
|
if CurNode.OutEdgeCount = 0 then
|
|
w := -CurNodeCount * CurNode.InEdgeCount
|
|
else
|
|
w := CurNode.OutEdgeCount - CurNode.InEdgeCount;
|
|
// if w=0 then // find outher criteria; edge length...
|
|
//DebugLn(w=0, ['LimitLevelHeights has node with zero weight. L=', CurLevel.Index, ' N=',CurNode.IndexInLevel, ' ', CurNode.Caption]);
|
|
|
|
j := 0;
|
|
while (j < i) and (NodeWeights[j].Weight < w) do
|
|
inc(j);
|
|
if j < i then
|
|
move(NodeWeights[j], NodeWeights[j+1], (i-j) * SizeOf(NodeWeights[0]));
|
|
NodeWeights[j].Node := CurNode;
|
|
NodeWeights[j].Weight := w;
|
|
end;
|
|
|
|
LevelsNeeded := (CurLevel.Count-1) div CurMaxHeight + 1;
|
|
assert(LevelsNeeded > 1, 'LimitLevelHeights: LevelsNeeded > 1');
|
|
for i := 0 to LevelsNeeded-2 do
|
|
NewLevelAtIndex(CurLevelIdx+1, SubGraphIdx);
|
|
|
|
i := CurLevel.Count;
|
|
while LevelsNeeded > 1 do begin
|
|
TargetLvlCnt := i div LevelsNeeded;
|
|
j := min(i, CurMaxHeight); // Nodes with no InEdge should be moved until MaxHeight, even if the distribution of nodes will be uneven
|
|
dec(LevelsNeeded);
|
|
CurLevel := Levels[CurLevelIdx+LevelsNeeded];
|
|
while ( (TargetLvlCnt > 0) or
|
|
( (j > 0) and (NodeWeights[i-1].Weight>=CurNodeCount) )
|
|
) and
|
|
not( (i<=MaxHeight) and (NodeWeights[i-1].Weight<=-CurNodeCount) ) // Keep as many Nodes with no outedge, in the left most column
|
|
do begin
|
|
dec(i);
|
|
NodeWeights[i].Node.Level := CurLevel;
|
|
dec(TargetLvlCnt);
|
|
dec(j);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.SplitLongEdges(SplitMode: TLvlGraphEdgeSplitMode);
|
|
// replace edges over several levels into several short edges by adding hidden nodes
|
|
type
|
|
THiddenGraphNodeArray = Array [boolean] of TLvlGraphNodeArray;
|
|
TNodeInfo = record
|
|
HiddenNodes: THiddenGraphNodeArray;
|
|
LongInEdges, LongOutEdges: integer;
|
|
end;
|
|
PNodeInfo = ^TNodeInfo;
|
|
|
|
var
|
|
NodeToInfo: TPointerToPointerTree; // node to TNodeInfo
|
|
n: Integer;
|
|
SourceNode: TLvlGraphNode;
|
|
e: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
TargetNode: TLvlGraphNode;
|
|
EdgeWeight: Single;
|
|
EdgeData: Pointer;
|
|
HiddenNodes: TLvlGraphNodeArray;
|
|
l: Integer;
|
|
LastNode: TLvlGraphNode;
|
|
NextNode: TLvlGraphNode;
|
|
AVLNode: TAvlTreeNode;
|
|
P2PItem: PPointerToPointerItem;
|
|
MergeAtSourceNode, EdgeBack: Boolean;
|
|
SourceInfo: PNodeInfo;
|
|
TargetInfo: PNodeInfo;
|
|
begin
|
|
if SplitMode=lgesNone then exit;
|
|
|
|
NodeToInfo:=TPointerToPointerTree.Create;
|
|
try
|
|
// create node infos
|
|
for n:=0 to NodeCount-1 do begin
|
|
SourceNode:=Nodes[n];
|
|
New(SourceInfo);
|
|
FillByte(SourceInfo^,SizeOf(TNodeInfo),0);
|
|
SetLength(SourceInfo^.HiddenNodes[False],LevelCount);
|
|
SetLength(SourceInfo^.HiddenNodes[True],LevelCount);
|
|
for e:=0 to SourceNode.OutEdgeCount-1 do begin
|
|
Edge:=SourceNode.OutEdges[e];
|
|
if Edge.Target.Level.Index-SourceNode.Level.Index<=1 then continue;
|
|
SourceInfo^.LongOutEdges+=1;
|
|
end;
|
|
for e:=0 to SourceNode.InEdgeCount-1 do begin
|
|
Edge:=SourceNode.InEdges[e];
|
|
if SourceNode.Level.Index-Edge.Source.Level.Index<=1 then continue;
|
|
SourceInfo^.LongInEdges+=1;
|
|
end;
|
|
//debugln(['TLvlGraph.SplitLongEdges ',SourceNode.Caption,' LongOutEdges=',SourceInfo^.LongOutEdges,' LongInEdges=',SourceInfo^.LongInEdges]);
|
|
NodeToInfo[SourceNode]:=SourceInfo;
|
|
end;
|
|
|
|
// split long edges
|
|
for n:=0 to NodeCount-1 do begin
|
|
SourceNode:=Nodes[n];
|
|
for e:=SourceNode.OutEdgeCount-1 downto 0 do begin // Note: run downwards, because edges will be deleted
|
|
Edge:=SourceNode.OutEdges[e];
|
|
TargetNode:=Edge.Target;
|
|
if TargetNode.Level.Index-SourceNode.Level.Index<=1 then continue;
|
|
//debugln(['TLvlGraph.SplitLongEdges long edge: ',SourceNode.Caption,'(',SourceNode.Level.Index,') ',TargetNode.Caption,'(',TargetNode.Level.Index,')']);
|
|
EdgeWeight:=Edge.Weight;
|
|
EdgeData:=Edge.Data;
|
|
EdgeBack:=Edge.BackEdge;
|
|
// remove long edge
|
|
Edge.Free;
|
|
// create merged hidden nodes
|
|
if SplitMode in [lgesMergeSource,lgesMergeTarget,lgesMergeHighest] then
|
|
begin
|
|
SourceInfo:=PNodeInfo(NodeToInfo[SourceNode]);
|
|
TargetInfo:=PNodeInfo(NodeToInfo[TargetNode]);
|
|
MergeAtSourceNode:=true;
|
|
case SplitMode of
|
|
lgesMergeTarget: MergeAtSourceNode:=false;
|
|
lgesMergeHighest: MergeAtSourceNode:=SourceInfo^.LongOutEdges>=TargetInfo^.LongInEdges;
|
|
end;
|
|
//debugln(['TLvlGraph.SplitLongEdges ',SourceNode.Caption,'=',SourceInfo^.LongOutEdges,' ',TargetNode.Caption,'=',TargetInfo^.LongInEdges,' MergeAtSourceNode=',MergeAtSourceNode]);
|
|
if MergeAtSourceNode then
|
|
HiddenNodes:=SourceInfo^.HiddenNodes[EdgeBack]
|
|
else
|
|
HiddenNodes:=TargetInfo^.HiddenNodes[EdgeBack];
|
|
// create hidden nodes
|
|
for l:=SourceNode.Level.Index+1 to TargetNode.Level.Index-1 do
|
|
if HiddenNodes[l]=nil then
|
|
HiddenNodes[l]:=CreateHiddenNode(l);
|
|
end;
|
|
// create edges
|
|
LastNode:=SourceNode;
|
|
for l:=SourceNode.Level.Index+1 to TargetNode.Level.Index do begin
|
|
if l<TargetNode.Level.Index then begin
|
|
if SplitMode=lgesSeparate then
|
|
NextNode:=CreateHiddenNode(l)
|
|
else
|
|
NextNode:=HiddenNodes[l];
|
|
end else
|
|
NextNode:=TargetNode;
|
|
Edge:=GetEdge(LastNode,NextNode,true);
|
|
Edge.Weight:=Edge.Weight+EdgeWeight;
|
|
Edge.FBackEdge:=EdgeBack;
|
|
if Edge.Data=nil then
|
|
Edge.Data:=EdgeData;
|
|
LastNode:=NextNode;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
// free NodeToInfo
|
|
AVLNode:=NodeToInfo.Tree.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
P2PItem:=PPointerToPointerItem(AVLNode.Data);
|
|
SourceInfo:=PNodeInfo(P2PItem^.Value);
|
|
Dispose(SourceInfo);
|
|
AVLNode:=NodeToInfo.Tree.FindSuccessor(AVLNode);
|
|
end;
|
|
NodeToInfo.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.ScaleNodeDrawSizes(NodeGapAbove, NodeGapBelow,
|
|
HardMaxTotal, HardMinOneNode, SoftMaxTotal, SoftMinOneNode: integer; out
|
|
PixelPerWeight: single);
|
|
{ NodeGapAbove: minimum space above each node
|
|
NodeGapBelow: minimum space below each node
|
|
HardMaxTotal: maximum size of largest level
|
|
HardMinOneNode: minimum size of a node
|
|
SoftMaxTotal: preferred maximum size of the largest level, total can be bigger
|
|
to achieve HardMinOneNode
|
|
SoftMinOneNode: preferred minimum size of a node, can be smaller to achieve
|
|
SoftMaxTotal
|
|
Order of precedence: HardMinOneNode, SoftMaxTotal, SoftMinOneNode
|
|
}
|
|
var
|
|
SmallestWeight: Single;
|
|
i: Integer;
|
|
Node: TLvlGraphNode;
|
|
j: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
Level: TLvlGraphLevel;
|
|
LvlWeight: Single;
|
|
MinPixelPerWeight, PrefMinPixelPerWeight: single;
|
|
DrawHeight: integer;
|
|
MaxPixelPerWeight, PrefMaxPixelPerWeight: single;
|
|
Gap: Integer;
|
|
begin
|
|
PixelPerWeight:=1.0;
|
|
//debugln(['TLvlGraph.ScaleNodeDrawSizes',
|
|
// ' NodeGapAbove=',NodeGapAbove,' NodeGapBelow=',NodeGapBelow,
|
|
// ' HardMaxTotal=',HardMaxTotal,' HardMinOneNode=',HardMinOneNode,
|
|
// ' SoftMaxTotal=',SoftMaxTotal,' SoftMinOneNode=',SoftMinOneNode]);
|
|
|
|
// sanitize input
|
|
HardMinOneNode:=Max(0,HardMinOneNode);
|
|
SoftMinOneNode:=Max(SoftMinOneNode,HardMinOneNode);
|
|
HardMaxTotal:=Max(1,HardMaxTotal);
|
|
SoftMaxTotal:=Min(Max(1,SoftMaxTotal),HardMaxTotal);
|
|
|
|
SmallestWeight:=-1.0;
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node:=Nodes[i];
|
|
for j:=0 to Node.OutEdgeCount-1 do begin
|
|
Edge:=Node.OutEdges[j];
|
|
if Edge.Weight<=0.0 then continue;
|
|
if (SmallestWeight<0) or (SmallestWeight>Edge.Weight) then
|
|
SmallestWeight:=Edge.Weight;
|
|
end;
|
|
end;
|
|
if SmallestWeight<0 then SmallestWeight:=1.0;
|
|
if SmallestWeight>0 then begin
|
|
MinPixelPerWeight:=single(HardMinOneNode)/SmallestWeight;
|
|
PrefMinPixelPerWeight:=single(SoftMinOneNode)/SmallestWeight;
|
|
end else begin
|
|
MinPixelPerWeight:=single(HardMinOneNode);
|
|
PrefMinPixelPerWeight:=single(SoftMinOneNode);
|
|
end;
|
|
//debugln(['TLvlGraph.ScaleNodeDrawSizes SmallestWeight=',SmallestWeight,
|
|
// ' MinPixelPerWeight=',MinPixelPerWeight,
|
|
// ' PrefMinPixelPerWeight=',PrefMinPixelPerWeight]);
|
|
|
|
MaxPixelPerWeight:=0.0;
|
|
PrefMaxPixelPerWeight:=0.0;
|
|
for i:=0 to LevelCount-1 do begin
|
|
Level:=Levels[i];
|
|
// LvlWeight = how much weight to draw
|
|
// DrawHeight - how much pixel left to draw the weight
|
|
LvlWeight:=0.0;
|
|
Gap:=0;
|
|
DrawHeight:=HardMaxTotal;
|
|
for j:=0 to Level.Count-1 do begin
|
|
// ToDo: Node is probably uninitialized.
|
|
LvlWeight+=Max(Node.InWeight,Node.OutWeight);
|
|
Gap+=NodeGapAbove+NodeGapBelow;
|
|
end;
|
|
if LvlWeight=0.0 then continue;
|
|
DrawHeight:=Max(1,HardMaxTotal-Gap);
|
|
PixelPerWeight:=single(DrawHeight)/LvlWeight;
|
|
if (MaxPixelPerWeight=0.0) or (MaxPixelPerWeight>PixelPerWeight) then
|
|
MaxPixelPerWeight:=PixelPerWeight;
|
|
DrawHeight:=Max(1,SoftMaxTotal-Gap);
|
|
PixelPerWeight:=single(DrawHeight)/LvlWeight;
|
|
if (PrefMaxPixelPerWeight=0.0) or (PrefMaxPixelPerWeight>PixelPerWeight) then
|
|
PrefMaxPixelPerWeight:=PixelPerWeight;
|
|
end;
|
|
//debugln(['TLvlGraph.ScaleNodeDrawSizes MaxPixelPerWeight=',MaxPixelPerWeight,' PrefMaxPixelPerWeight=',PrefMaxPixelPerWeight]);
|
|
|
|
PixelPerWeight:=PrefMinPixelPerWeight;
|
|
if PrefMaxPixelPerWeight>0.0 then
|
|
PixelPerWeight:=Min(PixelPerWeight,PrefMaxPixelPerWeight);
|
|
PixelPerWeight:=Max(PixelPerWeight,MinPixelPerWeight);
|
|
if MaxPixelPerWeight>0.0 then
|
|
PixelPerWeight:=Min(PixelPerWeight,MaxPixelPerWeight);
|
|
|
|
//debugln(['TLvlGraph.ScaleNodeDrawSizes PixelPerWeight=',PixelPerWeight]);
|
|
SetAllNodeDrawSizes(PixelPerWeight,SmallestWeight);
|
|
end;
|
|
|
|
procedure TLvlGraph.SetAllNodeDrawSizes(PixelPerWeight: single;
|
|
MinWeight: single);
|
|
var
|
|
i: Integer;
|
|
Node: TLvlGraphNode;
|
|
begin
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node:=Nodes[i];
|
|
Node.DrawSize:=round(Max(MinWeight,Max(Node.InWeight,Node.OutWeight))*PixelPerWeight+0.5);
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.MarkBackEdges;
|
|
var
|
|
i: Integer;
|
|
Node, OtherNode: TLvlGraphNode;
|
|
j, k: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
begin
|
|
for i:=0 to NodeCount-1 do
|
|
for j := 0 to Nodes[i].OutEdgeCount-1 do
|
|
Nodes[i].OutEdges[j].FNoGapCircle := False;
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node:=Nodes[i];
|
|
for j:=Node.OutEdgeCount-1 downto 0 do begin // Edges may be removed/replaced
|
|
Edge:=Node.OutEdges[j];
|
|
if Edge.IsBackEdge then
|
|
Edge.RevertDirection;
|
|
if Edge.Source.Level.Index = Edge.Target.Level.Index - 1 then begin
|
|
// check for circles of exactly 2 nodes, with no levels between
|
|
OtherNode := Edge.Source;
|
|
for k := 0 to OtherNode.OutEdgeCount - 1 do begin
|
|
if (OtherNode.OutEdges[k] <> Edge) and
|
|
(OtherNode.OutEdges[k].Target = Node) and
|
|
(not OtherNode.OutEdges[k].BackEdge)
|
|
then begin
|
|
Edge.FNoGapCircle := True;
|
|
OtherNode.OutEdges[k].FNoGapCircle := True;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.MinimizeCrossings;
|
|
begin
|
|
LvlGraphMinimizeCrossings(Self);
|
|
end;
|
|
|
|
procedure TLvlGraph.MinimizeOverlappings(MinPos: integer;
|
|
NodeGapAbove: integer; NodeGapBelow: integer; aLevel: integer);
|
|
var
|
|
i, Below: Integer;
|
|
Level: TLvlGraphLevel;
|
|
Node: TLvlGraphNode;
|
|
Last: TLvlGraphNode;
|
|
begin
|
|
if aLevel<0 then begin
|
|
for i:=0 to LevelCount-1 do
|
|
MinimizeOverlappings(MinPos,NodeGapAbove,NodeGapBelow,i);
|
|
end else begin
|
|
Level:=Levels[aLevel];
|
|
Last:=nil;
|
|
for i:=0 to Level.Count-1 do begin
|
|
Node:=Level[i];
|
|
Below := 0;
|
|
if (Last <> nil) and Last.Visible then
|
|
Below := NodeGapBelow;
|
|
if Last=nil then
|
|
Node.DrawPosition:=MinPos+NodeGapAbove
|
|
else if Node.Visible then
|
|
Node.DrawPosition:=Max(Node.DrawPosition,Last.DrawPositionEnd+Below+NodeGapAbove)
|
|
else
|
|
Node.DrawPosition:=Max(Node.DrawPosition,Last.DrawPositionEnd+1+Below);
|
|
//debugln(['TLvlGraph.MinimizeOverlappings Level=',aLevel,' Node=',Node.Caption,' Size=',Node.DrawSize,' Position=',Node.DrawPosition]);
|
|
Last:=Node;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.StraightenGraph;
|
|
const
|
|
DRAWPOS_UNKOWN = low(integer);
|
|
type
|
|
TNodeInfo = record
|
|
TheNode: TLvlGraphNode;
|
|
TheNodeIdx: Integer;
|
|
TheLevelIdx: Integer;
|
|
DrawPosGapAbove: integer;
|
|
CurDrawPos, TmpDrawPos: Integer;
|
|
end;
|
|
PNodeInfo = ^TNodeInfo;
|
|
var
|
|
NodeInfos: array of array of TNodeInfo;
|
|
|
|
function GetWantedDrawPosByAvgIn(NInfo: PNodeInfo): integer;
|
|
var
|
|
Node: TLvlGraphNode;
|
|
i: Integer;
|
|
begin
|
|
Node := NInfo^.TheNode;
|
|
if Node.InEdgeCount = 0 then
|
|
exit(DRAWPOS_UNKOWN);
|
|
Result := 0;
|
|
for i := 0 to Node.InEdgeCount - 1 do
|
|
Result := Result + Node.InEdges[i].Source.DrawCenter;
|
|
Result := (Result div (Node.InEdgeCount));
|
|
end;
|
|
|
|
function GetWantedDrawPosByAvgOut(NInfo: PNodeInfo): integer;
|
|
var
|
|
Node: TLvlGraphNode;
|
|
i: Integer;
|
|
begin
|
|
Node := NInfo^.TheNode;
|
|
if Node.OutEdgeCount = 0 then
|
|
exit(DRAWPOS_UNKOWN);
|
|
Result := 0;
|
|
for i := 0 to Node.OutEdgeCount - 1 do
|
|
Result := Result + Node.OutEdges[i].Target.DrawCenter;
|
|
Result := (Result div (Node.OutEdgeCount));
|
|
end;
|
|
|
|
procedure PreComputeWantedPositions(ALvlIdx, AnInWeight, AnOutWeight: integer);
|
|
var
|
|
Level: TLvlGraphLevel;
|
|
NodeIdx: Integer;
|
|
NInfo: PNodeInfo;
|
|
begin
|
|
Level := Levels[ALvlIdx];
|
|
if Level.Count = 0 then
|
|
exit;
|
|
|
|
if (AnInWeight > 0) and (AnOutWeight > 0) then
|
|
for NodeIdx := 0 to Level.Count - 1 do begin
|
|
NInfo := @NodeInfos[ALvlIdx, NodeIdx];
|
|
if (NInfo^.TheNode.OutEdgeCount > 0) and (NInfo^.TheNode.InEdgeCount > 0) then
|
|
NInfo^.TmpDrawPos := (
|
|
GetWantedDrawPosByAvgOut(NInfo) * AnOutWeight * NInfo^.TheNode.OutEdgeCount +
|
|
GetWantedDrawPosByAvgIn(NInfo) * AnInWeight * NInfo^.TheNode.InEdgeCount
|
|
) div (AnOutWeight * NInfo^.TheNode.OutEdgeCount + AnInWeight * NInfo^.TheNode.InEdgeCount)
|
|
else
|
|
if (NInfo^.TheNode.OutEdgeCount > 0) then
|
|
NInfo^.TmpDrawPos := GetWantedDrawPosByAvgOut(NInfo)
|
|
else
|
|
NInfo^.TmpDrawPos := GetWantedDrawPosByAvgIn(NInfo);
|
|
end
|
|
else
|
|
if AnOutWeight > 0 then
|
|
for NodeIdx := 0 to Level.Count - 1 do begin
|
|
NInfo := @NodeInfos[ALvlIdx, NodeIdx];
|
|
NInfo^.TmpDrawPos := GetWantedDrawPosByAvgOut(NInfo);
|
|
end
|
|
else
|
|
for NodeIdx := 0 to Level.Count - 1 do begin
|
|
NInfo := @NodeInfos[ALvlIdx, NodeIdx];
|
|
NInfo^.TmpDrawPos := GetWantedDrawPosByAvgIn(NInfo);
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure AdjustNodesInLevel(ALvlIdx, AMinDrawPos, AMaxDrawPos: integer);
|
|
var
|
|
Level: TLvlGraphLevel;
|
|
i, NodeIdx: Integer;
|
|
PushUpNeeded, PushUpAllowed, FreeGapAbove: Integer;
|
|
CurGroupWeight, CurGroupCnt, WantedPos: Integer;
|
|
NInfo, NInfoPrev, PushNode, PushNodePrev: PNodeInfo;
|
|
Node: TLvlGraphNode;
|
|
begin
|
|
Level := Levels[ALvlIdx];
|
|
if Level.Count = 0 then
|
|
exit;
|
|
|
|
NInfoPrev := @NodeInfos[ALvlIdx, 0];
|
|
if (NInfoPrev^.TmpDrawPos <> DRAWPOS_UNKOWN) and
|
|
(NInfoPrev^.TmpDrawPos >= AMinDrawPos + NInfoPrev^.DrawPosGapAbove)
|
|
then
|
|
NInfoPrev^.CurDrawPos := NInfoPrev^.TmpDrawPos
|
|
else
|
|
NInfoPrev^.CurDrawPos := AMinDrawPos + NInfoPrev^.DrawPosGapAbove;
|
|
NInfoPrev^.TheNode.DrawCenter := NInfoPrev^.CurDrawPos;
|
|
|
|
for NodeIdx := 1 to Level.Count - 1 do begin
|
|
NInfo := @NodeInfos[ALvlIdx, NodeIdx];
|
|
Node := NInfo^.TheNode;
|
|
if NInfo^.TmpDrawPos <> DRAWPOS_UNKOWN then begin
|
|
NInfo^.CurDrawPos := NInfo^.TmpDrawPos;
|
|
PushUpNeeded := (NInfoPrev^.CurDrawPos + NInfo^.DrawPosGapAbove) - NInfo^.TmpDrawPos;
|
|
end
|
|
else begin
|
|
NInfo^.CurDrawPos := NInfoPrev^.CurDrawPos + NInfo^.DrawPosGapAbove;
|
|
PushUpNeeded := 0;
|
|
end;
|
|
|
|
if PushUpNeeded > 0 then begin
|
|
NInfo^.CurDrawPos := NInfo^.TmpDrawPos + PushUpNeeded; // default pos
|
|
PushUpAllowed := 0;
|
|
// try to push up prev node
|
|
CurGroupWeight := 0; // negative: nodes have up-pull / positive: nodes have down-pull
|
|
CurGroupCnt := 0;
|
|
PushNode := NInfo;
|
|
while (PushNode <> nil) do begin
|
|
if PushNode^.TmpDrawPos <> DRAWPOS_UNKOWN then begin
|
|
CurGroupWeight := CurGroupWeight + PushNode^.TmpDrawPos - PushNode^.CurDrawPos;
|
|
inc(CurGroupCnt);
|
|
end;
|
|
|
|
if PushNode^.TheNodeIdx = 0 then begin
|
|
PushNodePrev := nil;
|
|
i := AMinDrawPos;
|
|
end
|
|
else begin
|
|
PushNodePrev := @NodeInfos[ALvlIdx, PushNode^.TheNodeIdx-1];
|
|
i := PushNodePrev^.CurDrawPos;
|
|
end;
|
|
|
|
FreeGapAbove := PushNode^.CurDrawPos - PushNode^.DrawPosGapAbove - i;
|
|
if (FreeGapAbove = 0) and (PushNodePrev = nil) then
|
|
break; // can not push any further
|
|
if (FreeGapAbove > 0) then begin
|
|
// push
|
|
if CurGroupWeight >= 0 then
|
|
break; // can not pull up
|
|
Assert((CurGroupCnt > 0) or (CurGroupWeight = 0), 'AdjustNodesInLevel: (CurGroupCnt > 0) or (CurGroupWeight = 0)');
|
|
i := 0;
|
|
if CurGroupCnt > 0 then
|
|
i := -(CurGroupWeight - CurGroupCnt div 2) div CurGroupCnt;
|
|
i := Min(Min(i, PushUpNeeded), FreeGapAbove);
|
|
PushUpAllowed := PushUpAllowed + i;
|
|
PushUpNeeded := PushUpNeeded - i;
|
|
|
|
if (PushUpNeeded <= 0) or (i < FreeGapAbove) then
|
|
break;
|
|
CurGroupWeight := CurGroupWeight + i * CurGroupCnt;
|
|
end;
|
|
|
|
PushNode := PushNodePrev;
|
|
end; // while (PushNode <> nil) do begin
|
|
|
|
if NInfo^.CurDrawPos - PushUpAllowed > AMaxDrawPos then // force pushup
|
|
PushUpAllowed := NInfo^.CurDrawPos - AMaxDrawPos;
|
|
|
|
if PushUpAllowed > 0 then begin
|
|
WantedPos := NInfo^.CurDrawPos - PushUpAllowed;
|
|
NInfo^.CurDrawPos := WantedPos;
|
|
NInfo^.TheNode.DrawCenter := WantedPos;
|
|
PushNode := NInfo;
|
|
i := 0; // the current (first) node wants to move
|
|
while (PushNode <> nil) and (PushNode^.TheNodeIdx > 0) do begin
|
|
WantedPos := WantedPos - PushNode^.DrawPosGapAbove;
|
|
PushNodePrev := @NodeInfos[ALvlIdx, PushNode^.TheNodeIdx-1];
|
|
if PushNodePrev^.CurDrawPos <= WantedPos then
|
|
break;
|
|
PushNodePrev^.CurDrawPos := WantedPos;
|
|
PushNodePrev^.TheNode.DrawCenter := WantedPos;
|
|
PushNode := PushNodePrev;
|
|
end;
|
|
end;
|
|
end
|
|
|
|
else // if PushUpNeeded > 0 then begin
|
|
if (NInfoPrev^.TmpDrawPos = DRAWPOS_UNKOWN) then begin
|
|
// re-distribute nodes with unknown weight to avg between upper/lower
|
|
// They depend on the nodes on the other side, but that is a cyclic dependecy....
|
|
PushNode := NInfoPrev;
|
|
CurGroupCnt := 1;
|
|
while (PushNode <> nil) and (PushNode^.TmpDrawPos = DRAWPOS_UNKOWN) do begin
|
|
PushNodePrev := PushNode; // node below
|
|
inc(CurGroupCnt);
|
|
if PushNode^.TheNodeIdx > 0 then
|
|
PushNode := @NodeInfos[ALvlIdx, PushNode^.TheNodeIdx-1]
|
|
else
|
|
PushNode := nil;
|
|
end;
|
|
FreeGapAbove := 0;
|
|
if PushNode <> nil then
|
|
FreeGapAbove := NInfo^.CurDrawPos - NInfo^.DrawPosGapAbove - NInfoPrev^.CurDrawPos;
|
|
PushNode := NInfoPrev;
|
|
PushNodePrev := NInfo;
|
|
while (PushNode <> nil) and (PushNode^.TmpDrawPos = DRAWPOS_UNKOWN) do begin
|
|
i := FreeGapAbove div CurGroupCnt;
|
|
WantedPos := PushNodePrev^.CurDrawPos - PushNodePrev^.DrawPosGapAbove - i;
|
|
FreeGapAbove := FreeGapAbove - i;
|
|
dec(CurGroupCnt);
|
|
PushNode^.CurDrawPos := WantedPos;
|
|
PushNode^.TheNode.DrawCenter := WantedPos;
|
|
PushNodePrev := PushNode;
|
|
if PushNode^.TheNodeIdx > 0 then
|
|
PushNode := @NodeInfos[ALvlIdx, PushNode^.TheNodeIdx-1]
|
|
else
|
|
PushNode := nil;
|
|
end;
|
|
end;
|
|
|
|
Node.DrawCenter := NInfo^.CurDrawPos;
|
|
NInfoPrev:= NInfo;
|
|
end;
|
|
end;
|
|
|
|
procedure ProcessSubGraph(ALowLevelIdx, AHighLevelIdx: integer);
|
|
var
|
|
MaxLevelCount, LvlIdx: integer;
|
|
j, c, MaxDrawPos, MaxLvlIdx: integer;
|
|
Node: TLvlGraphNode;
|
|
Level: TLvlGraphLevel;
|
|
NInfo, NInfoPrev: PNodeInfo;
|
|
begin
|
|
if AHighLevelIdx <= ALowLevelIdx then
|
|
exit;
|
|
MaxLvlIdx := -1;
|
|
MaxLevelCount := 0;
|
|
MaxDrawPos := 0;
|
|
SetLength(NodeInfos, LevelCount);
|
|
NInfoPrev := nil;
|
|
for LvlIdx := ALowLevelIdx to AHighLevelIdx do begin
|
|
Level := Levels[LvlIdx];
|
|
if Level.Count > MaxLevelCount then
|
|
MaxLevelCount := Level.Count;
|
|
SetLength(NodeInfos[LvlIdx], Level.Count);
|
|
c := Level.Count - 1;
|
|
for j := 0 to c do begin
|
|
Node := Level.Nodes[j];
|
|
NInfo := @NodeInfos[LvlIdx,j];
|
|
NInfo^.TheNode := Node;
|
|
NInfo^.TheNodeIdx := j;
|
|
NInfo^.TheLevelIdx := LvlIdx;
|
|
NInfo^.CurDrawPos := Node.DrawCenter;
|
|
if j = 0 then
|
|
NInfo^.DrawPosGapAbove := NInfo^.CurDrawPos
|
|
else
|
|
NInfo^.DrawPosGapAbove := NInfo^.CurDrawPos - NInfoPrev^.CurDrawPos;
|
|
NInfoPrev := NInfo;
|
|
end;
|
|
if (c > 0) and (Node.DrawCenter > MaxDrawPos) then begin
|
|
MaxDrawPos := Node.DrawCenter;
|
|
MaxLvlIdx := LvlIdx;
|
|
end;
|
|
end;
|
|
if MaxLvlIdx < 0 then
|
|
exit;
|
|
|
|
|
|
for LvlIdx := MaxLvlIdx+1 to AHighLevelIdx do begin
|
|
PreComputeWantedPositions(LvlIdx, 1, 0);
|
|
AdjustNodesInLevel(LvlIdx, 0, MaxDrawPos);
|
|
end;
|
|
for LvlIdx := MaxLvlIdx-1 downto ALowLevelIdx do begin
|
|
PreComputeWantedPositions(LvlIdx, 0, 1);
|
|
AdjustNodesInLevel(LvlIdx, 0, MaxDrawPos);
|
|
end;
|
|
|
|
for j := 0 to 1 do begin
|
|
for LvlIdx := ALowLevelIdx to AHighLevelIdx do begin
|
|
PreComputeWantedPositions(LvlIdx, 1, 1);
|
|
AdjustNodesInLevel(LvlIdx, 0, MaxDrawPos);
|
|
end;
|
|
for LvlIdx := AHighLevelIdx downto ALowLevelIdx do begin
|
|
PreComputeWantedPositions(LvlIdx, 1, 1);
|
|
AdjustNodesInLevel(LvlIdx, 0, MaxDrawPos);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
begin
|
|
For i := 0 to SubGraphCount-1 do
|
|
ProcessSubGraph(SubGraphs[i].LowestLevel, SubGraphs[i].HighestLevel);
|
|
end;
|
|
|
|
procedure TLvlGraph.SetColors(Palette: TLazCtrlPalette);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to NodeCount-1 do
|
|
Nodes[i].Color:=Palette[i];
|
|
end;
|
|
|
|
procedure TLvlGraph.WriteDebugReport(Msg: string);
|
|
var
|
|
l: Integer;
|
|
Level: TLvlGraphLevel;
|
|
i: Integer;
|
|
Node: TLvlGraphNode;
|
|
Edge: TLvlGraphEdge;
|
|
j: Integer;
|
|
begin
|
|
debugln([Msg,' NodeCount=',NodeCount,' LevelCount=',LevelCount]);
|
|
debugln([' Nodes:']);
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node:=Nodes[i];
|
|
dbgout([' ',i,'/',NodeCount,': "',Node.Caption,'" OutEdges:']);
|
|
for j:=0 to Node.OutEdgeCount-1 do begin
|
|
Edge:=Node.OutEdges[j];
|
|
dbgout('"',Edge.Target.Caption,'",');
|
|
end;
|
|
debugln;
|
|
end;
|
|
debugln([' Levels:']);
|
|
for l:=0 to LevelCount-1 do begin
|
|
dbgout([' Level: ',l,'/',LevelCount]);
|
|
Level:=Levels[l];
|
|
if l<>Level.Index then
|
|
debugln(['ERROR: l<>Level.Index=',Level.Index]);
|
|
dbgout(' ');
|
|
for i:=0 to Level.Count-1 do begin
|
|
dbgout('"',Level.Nodes[i].Caption,'",');
|
|
end;
|
|
debugln;
|
|
end;
|
|
end;
|
|
|
|
procedure TLvlGraph.ConsistencyCheck(WithBackEdge: boolean);
|
|
var
|
|
i: Integer;
|
|
Node: TLvlGraphNode;
|
|
j: Integer;
|
|
Edge: TLvlGraphEdge;
|
|
Level: TLvlGraphLevel;
|
|
begin
|
|
for i:=0 to LevelCount-1 do begin
|
|
Level:=Levels[i];
|
|
if Level.Index<>i then
|
|
raise Exception.Create('');
|
|
for j:=0 to Level.Count-1 do begin
|
|
Node:=Level.Nodes[j];
|
|
if Node.Level<>Level then
|
|
raise Exception.Create('');
|
|
if Level.IndexOf(Node)<j then
|
|
raise Exception.Create('');
|
|
end;
|
|
end;
|
|
for i:=0 to NodeCount-1 do begin
|
|
Node:=Nodes[i];
|
|
for j:=0 to Node.OutEdgeCount-1 do begin
|
|
Edge:=Node.OutEdges[j];
|
|
if Edge.Source<>Node then
|
|
raise Exception.Create('');
|
|
if Edge.Target.FInEdges.IndexOf(Edge)<0 then
|
|
raise Exception.Create('');
|
|
// An edge can EITHER be marked "BackEdge" or be "IsBackEdge" (aka target is before source).
|
|
// An egge is not allowed ot be both.
|
|
if WithBackEdge and Edge.BackEdge and Edge.IsBackEdge then
|
|
raise Exception.Create('Edge.BackEdge '+Edge.AsString+' Edge.BackEdge='+dbgs(Edge.BackEdge)+' Edge.IsBackEdge='+dbgs(Edge.IsBackEdge)+' Source.Index='+dbgs(Edge.Source.Level.Index)+' Target.Index='+dbgs(Edge.Target.Level.Index));
|
|
end;
|
|
for j:=0 to Node.InEdgeCount-1 do begin
|
|
Edge:=Node.InEdges[j];
|
|
if Edge.Target<>Node then
|
|
raise Exception.Create('');
|
|
if Edge.Source.FOutEdges.IndexOf(Edge)<0 then
|
|
raise Exception.Create('');
|
|
end;
|
|
if Node.Level.fNodes.IndexOf(Node)<0 then
|
|
raise Exception.Create('');
|
|
end;
|
|
end;
|
|
|
|
{ TLvlGraphEdge }
|
|
|
|
procedure TLvlGraphEdge.SetWeight(AValue: single);
|
|
var
|
|
Diff: single;
|
|
begin
|
|
if AValue<0.0 then AValue:=0.0;
|
|
if FWeight=AValue then Exit;
|
|
Diff:=AValue-FWeight;
|
|
Source.FOutWeight+=Diff;
|
|
Target.FInWeight+=Diff;
|
|
FWeight:=AValue;
|
|
Source.Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphEdge.SetHighlighted(AValue: boolean);
|
|
begin
|
|
if FHighlighted=AValue then Exit;
|
|
FHighlighted:=AValue;
|
|
Source.Invalidate;
|
|
end;
|
|
|
|
constructor TLvlGraphEdge.Create(TheSource: TLvlGraphNode;
|
|
TheTarget: TLvlGraphNode);
|
|
begin
|
|
FSource:=TheSource;
|
|
FTarget:=TheTarget;
|
|
Source.FOutEdges.Add(Self);
|
|
Target.FInEdges.Add(Self);
|
|
end;
|
|
|
|
destructor TLvlGraphEdge.Destroy;
|
|
var
|
|
OldGraph: TLvlGraph;
|
|
begin
|
|
OldGraph:=Source.Graph;
|
|
Source.FOutEdges.Remove(Self);
|
|
Target.FInEdges.Remove(Self);
|
|
Source.FOutWeight-=FWeight;
|
|
Target.FInWeight-=FWeight;
|
|
FSource:=nil;
|
|
FTarget:=nil;
|
|
if OldGraph<>nil then
|
|
OldGraph.StructureChanged(Self,opRemove);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TLvlGraphEdge.IsBackEdge: boolean;
|
|
begin
|
|
Result:=Source.Level.Index>=Target.Level.Index;
|
|
end;
|
|
|
|
procedure TLvlGraphEdge.RevertDirection;
|
|
var
|
|
t: TLvlGraphNode;
|
|
begin
|
|
Source.FOutEdges.Remove(Self);
|
|
Target.FInEdges.Remove(Self);
|
|
Source.FOutWeight-=FWeight;
|
|
Target.FInWeight-=FWeight;
|
|
|
|
t := FSource;
|
|
FSource := FTarget;
|
|
FTarget := t;
|
|
|
|
Source.FOutEdges.Add(Self);
|
|
Target.FInEdges.Add(Self);
|
|
Source.FOutWeight+=FWeight;
|
|
Target.FInWeight+=FWeight;
|
|
FBackEdge := not FBackEdge;
|
|
end;
|
|
|
|
function TLvlGraphEdge.GetVisibleSourceNodes: TLvlGraphNodeArray;
|
|
// return all visible nodes connected in Source direction
|
|
begin
|
|
Result:=NodeAVLTreeToNodeArray(GetVisibleSourceNodesAsAVLTree,true,true);
|
|
end;
|
|
|
|
function TLvlGraphEdge.GetVisibleSourceNodesAsAVLTree: TAvlTree;
|
|
// return all visible nodes connected in Source direction
|
|
var
|
|
Visited: TAvlTree;
|
|
|
|
procedure Search(Node: TLvlGraphNode);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Node=nil then exit;
|
|
if Visited.Find(Node)<>nil then exit;
|
|
Visited.Add(Node);
|
|
if Node.Visible then begin
|
|
Result.Add(Node);
|
|
end else begin
|
|
for i:=0 to Node.InEdgeCount-1 do
|
|
Search(Node.InEdges[i].Source);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if BackEdge then begin
|
|
FBackEdge := False;
|
|
Result := GetVisibleTargetNodesAsAVLTree;
|
|
FBackEdge := True;
|
|
exit;
|
|
end;
|
|
Result:=TAvlTree.Create;
|
|
Visited:=TAvlTree.Create;
|
|
try
|
|
Search(Source);
|
|
finally
|
|
Visited.Free;
|
|
end;
|
|
end;
|
|
|
|
function TLvlGraphEdge.GetVisibleTargetNodes: TLvlGraphNodeArray;
|
|
// return all visible nodes connected in Target direction
|
|
begin
|
|
Result:=NodeAVLTreeToNodeArray(GetVisibleTargetNodesAsAVLTree,true,true);
|
|
end;
|
|
|
|
function TLvlGraphEdge.GetVisibleTargetNodesAsAVLTree: TAvlTree;
|
|
// return all visible nodes connected in Target direction
|
|
var
|
|
Visited: TAvlTree;
|
|
|
|
procedure Search(Node: TLvlGraphNode);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Node=nil then exit;
|
|
if Visited.Find(Node)<>nil then exit;
|
|
Visited.Add(Node);
|
|
if Node.Visible then begin
|
|
Result.Add(Node);
|
|
end else begin
|
|
for i:=0 to Node.OutEdgeCount-1 do
|
|
Search(Node.OutEdges[i].Target);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if BackEdge then begin
|
|
FBackEdge := False;
|
|
Result := GetVisibleSourceNodesAsAVLTree;
|
|
FBackEdge := True;
|
|
exit;
|
|
end;
|
|
Result:=TAvlTree.Create;
|
|
Visited:=TAvlTree.Create;
|
|
try
|
|
Search(Target);
|
|
finally
|
|
Visited.Free;
|
|
end;
|
|
end;
|
|
|
|
function TLvlGraphEdge.AsString: string;
|
|
begin
|
|
Result:='('+Source.Caption+'->'+Target.Caption+')';
|
|
end;
|
|
|
|
{ TLvlGraphNode }
|
|
|
|
function TLvlGraphNode.InEdgeCount: integer;
|
|
begin
|
|
Result:=FInEdges.Count;
|
|
end;
|
|
|
|
function TLvlGraphNode.GetInEdges(Index: integer): TLvlGraphEdge;
|
|
begin
|
|
Result:=TLvlGraphEdge(FInEdges[Index]);
|
|
end;
|
|
|
|
function TLvlGraphNode.GetIndexInLevel: integer;
|
|
begin
|
|
if Level=nil then exit(-1);
|
|
Result:=Level.IndexOf(Self);
|
|
end;
|
|
|
|
function TLvlGraphNode.GetOutEdges(Index: integer): TLvlGraphEdge;
|
|
begin
|
|
Result:=TLvlGraphEdge(FOutEdges[Index]);
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetCaption(AValue: string);
|
|
begin
|
|
if FCaption=AValue then Exit;
|
|
FCaption:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetColor(AValue: TFPColor);
|
|
begin
|
|
if FColor=AValue then Exit;
|
|
FColor:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.OnLevelDestroy;
|
|
begin
|
|
if Level.Index>0 then
|
|
Level:=Graph.Levels[0]
|
|
else if Graph.LevelCount>1 then
|
|
Level:=Graph.Levels[1]
|
|
else
|
|
fLevel:=nil;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetDrawCenter(AValue: integer);
|
|
begin
|
|
DrawPosition := AValue-(DrawSize div 2);
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetDrawSize(AValue: integer);
|
|
begin
|
|
if FDrawSize=AValue then Exit;
|
|
FDrawSize:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetImageEffect(AValue: TGraphicsDrawEffect);
|
|
begin
|
|
if FImageEffect=AValue then Exit;
|
|
FImageEffect:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetImageIndex(AValue: integer);
|
|
begin
|
|
if FImageIndex=AValue then Exit;
|
|
FImageIndex:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetIndexInLevel(AValue: integer);
|
|
begin
|
|
Level.MoveNode(Self,AValue);
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetLevel(AValue: TLvlGraphLevel);
|
|
begin
|
|
if AValue=nil then
|
|
raise Exception.Create('node needs a level');
|
|
if AValue.Graph<>Graph then
|
|
raise Exception.Create('wrong graph');
|
|
if FLevel=AValue then Exit;
|
|
if FLevel<>nil then
|
|
UnbindLevel;
|
|
FLevel:=AValue;
|
|
FLevel.fNodes.Add(Self);
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetOverlayIndex(AValue: integer);
|
|
begin
|
|
if FOverlayIndex=AValue then Exit;
|
|
FOverlayIndex:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetSelected(AValue: boolean);
|
|
|
|
procedure Unselect;
|
|
begin
|
|
if FPrevSelected<>nil then
|
|
FPrevSelected.FNextSelected:=FNextSelected
|
|
else
|
|
Graph.FFirstSelected:=FNextSelected;
|
|
if FNextSelected<>nil then
|
|
FNextSelected.FPrevSelected:=FPrevSelected
|
|
else
|
|
Graph.FLastSelected:=FPrevSelected;
|
|
FNextSelected:=nil;
|
|
FPrevSelected:=nil;
|
|
end;
|
|
|
|
procedure Select;
|
|
begin
|
|
FPrevSelected:=Graph.LastSelected;
|
|
if FPrevSelected<>nil then
|
|
FPrevSelected.FNextSelected:=Self
|
|
else
|
|
Graph.FFirstSelected:=Self;
|
|
Graph.FLastSelected:=Self;
|
|
end;
|
|
|
|
begin
|
|
if FSelected=AValue then begin
|
|
if Graph=nil then exit;
|
|
if not FSelected then exit;
|
|
if Graph.LastSelected=Self then exit;
|
|
// make this node the last selected
|
|
Unselect;
|
|
Select;
|
|
SelectionChanged;
|
|
exit;
|
|
end;
|
|
// change Selected
|
|
FSelected:=AValue;
|
|
if Graph<>nil then begin
|
|
if Selected then begin
|
|
Select;
|
|
end else begin
|
|
Unselect;
|
|
end;
|
|
end;
|
|
SelectionChanged;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetSubGraph(AValue: Integer);
|
|
begin
|
|
if FSubGraph = AValue then Exit;
|
|
if (AValue < 0) or (AValue >= FGraph.SubGraphCount) then
|
|
raise Exception.Create('subgraph index out of range');
|
|
|
|
FSubGraph := AValue;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SetVisible(AValue: boolean);
|
|
begin
|
|
if FVisible=AValue then Exit;
|
|
FVisible:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.UnbindLevel;
|
|
begin
|
|
if FLevel<>nil then
|
|
FLevel.fNodes.Remove(Self);
|
|
end;
|
|
|
|
procedure TLvlGraphNode.SelectionChanged;
|
|
begin
|
|
if Graph<>nil then
|
|
Graph.SelectionChanged;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.Invalidate;
|
|
begin
|
|
if Graph<>nil then
|
|
Graph.Invalidate;
|
|
end;
|
|
|
|
constructor TLvlGraphNode.Create(TheGraph: TLvlGraph; TheCaption: string;
|
|
TheLevel: TLvlGraphLevel);
|
|
begin
|
|
FGraph:=TheGraph;
|
|
FCaption:=TheCaption;
|
|
FInEdges:=TFPList.Create;
|
|
FOutEdges:=TFPList.Create;
|
|
FDrawSize:=1;
|
|
FVisible:=true;
|
|
FImageIndex:=-1;
|
|
FOverlayIndex:=-1;
|
|
FImageEffect:=DefaultLvlGraphNodeImageEffect;
|
|
Level:=TheLevel;
|
|
end;
|
|
|
|
destructor TLvlGraphNode.Destroy;
|
|
begin
|
|
Selected:=false;
|
|
Clear;
|
|
UnbindLevel;
|
|
if Graph<>nil then
|
|
Graph.InternalRemoveNode(Self);
|
|
FreeAndNil(FInEdges);
|
|
FreeAndNil(FOutEdges);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TLvlGraphNode.Clear;
|
|
begin
|
|
while InEdgeCount>0 do
|
|
InEdges[InEdgeCount-1].Free;
|
|
while OutEdgeCount>0 do
|
|
OutEdges[OutEdgeCount-1].Free;
|
|
end;
|
|
|
|
function TLvlGraphNode.IndexOfInEdge(Source: TLvlGraphNode): integer;
|
|
begin
|
|
for Result:=0 to InEdgeCount-1 do
|
|
if InEdges[Result].Source=Source then exit;
|
|
Result:=-1;
|
|
end;
|
|
|
|
function TLvlGraphNode.FindInEdge(Source: TLvlGraphNode): TLvlGraphEdge;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=IndexOfInEdge(Source);
|
|
if i>=0 then
|
|
Result:=InEdges[i]
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TLvlGraphNode.IndexOfOutEdge(Target: TLvlGraphNode): integer;
|
|
begin
|
|
for Result:=0 to OutEdgeCount-1 do
|
|
if OutEdges[Result].Target=Target then exit;
|
|
Result:=-1;
|
|
end;
|
|
|
|
function TLvlGraphNode.FindOutEdge(Target: TLvlGraphNode): TLvlGraphEdge;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=IndexOfOutEdge(Target);
|
|
if i>=0 then
|
|
Result:=OutEdges[i]
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TLvlGraphNode.OutEdgeCount: integer;
|
|
begin
|
|
Result:=FOutEdges.Count;
|
|
end;
|
|
|
|
function TLvlGraphNode.GetVisibleSourceNodes: TLvlGraphNodeArray;
|
|
// return all visible nodes connected in Source direction
|
|
begin
|
|
Result:=NodeAVLTreeToNodeArray(GetVisibleSourceNodesAsAVLTree,true,true);
|
|
end;
|
|
|
|
procedure SearchForTargets(Node: TLvlGraphNode; AResult, Visited: TAvlTree);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Node=nil then exit;
|
|
if Visited.Find(Node)<>nil then exit;
|
|
Visited.Add(Node);
|
|
if Node.Visible then begin
|
|
AResult.Add(Node);
|
|
end else begin
|
|
for i:=0 to Node.OutEdgeCount-1 do
|
|
SearchForTargets(Node.OutEdges[i].Target, AResult, Visited);
|
|
end;
|
|
end;
|
|
|
|
procedure SearchForSources(Node: TLvlGraphNode; AResult: TAvlTree);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Node=nil then exit;
|
|
if Node.Visible then begin
|
|
AResult.Add(Node);
|
|
end else begin
|
|
for i:=0 to Node.InEdgeCount-1 do
|
|
SearchForSources(Node.InEdges[i].Source, AResult);
|
|
end;
|
|
end;
|
|
|
|
function TLvlGraphNode.GetVisibleSourceNodesAsAVLTree: TAvlTree;
|
|
// return all visible nodes connected in Source direction
|
|
var
|
|
i: Integer;
|
|
Visited: TAvlTree;
|
|
begin
|
|
Result:=TAvlTree.Create;
|
|
Visited:=TAvlTree.Create;
|
|
try
|
|
for i:=0 to InEdgeCount-1 do
|
|
if not InEdges[i].BackEdge then
|
|
SearchForSources(InEdges[i].Source, Result);
|
|
for i:=0 to OutEdgeCount-1 do
|
|
if OutEdges[i].BackEdge then
|
|
SearchForTargets(OutEdges[i].Target, Result, Visited);
|
|
finally
|
|
Visited.Free;
|
|
end;
|
|
end;
|
|
|
|
function TLvlGraphNode.GetVisibleTargetNodes: TLvlGraphNodeArray;
|
|
// return all visible nodes connected in Target direction
|
|
begin
|
|
Result:=NodeAVLTreeToNodeArray(GetVisibleTargetNodesAsAVLTree,true,true);
|
|
end;
|
|
|
|
function TLvlGraphNode.GetVisibleTargetNodesAsAVLTree: TAvlTree;
|
|
// return all visible nodes connected in Target direction
|
|
var
|
|
Visited: TAvlTree;
|
|
i: Integer;
|
|
begin
|
|
Result:=TAvlTree.Create;
|
|
Visited:=TAvlTree.Create;
|
|
try
|
|
for i:=0 to OutEdgeCount-1 do
|
|
if not OutEdges[i].BackEdge then
|
|
SearchForTargets(OutEdges[i].Target, Result, Visited);
|
|
for i:=0 to InEdgeCount-1 do
|
|
if InEdges[i].BackEdge then
|
|
SearchForSources(InEdges[i].Source, Result);
|
|
finally
|
|
Visited.Free;
|
|
end;
|
|
end;
|
|
|
|
function TLvlGraphNode.GetDrawCenter: integer;
|
|
begin
|
|
Result:=DrawPosition+(DrawSize div 2);
|
|
end;
|
|
|
|
function TLvlGraphNode.DrawPositionEnd: integer;
|
|
begin
|
|
Result:=DrawPosition+DrawSize;
|
|
end;
|
|
|
|
end.
|
|
|