From bd90241752ff498f8f46765dd5f32e5c3d9c8928 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 18 Mar 2013 18:50:49 +0000 Subject: [PATCH] lazcontrols: added TLvlGraphControl git-svn-id: trunk@40584 - --- .gitattributes | 1 + components/codetools/ide/codyctrls.pas | 3689 ------------------ components/codetools/ide/codyunitdepwnd.pas | 2 +- components/lazcontrols/lazcontrols.lpk | 8 +- components/lazcontrols/lazcontrols.pas | 2 +- components/lazcontrols/lvlgraphctrl.pas | 3715 +++++++++++++++++++ 6 files changed, 3724 insertions(+), 3693 deletions(-) create mode 100644 components/lazcontrols/lvlgraphctrl.pas diff --git a/.gitattributes b/.gitattributes index 64e6763a56..6736777e43 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1699,6 +1699,7 @@ components/lazcontrols/lazcontrols.lpk svneol=native#text/xml components/lazcontrols/lazcontrols.pas svneol=native#text/pascal components/lazcontrols/listfilteredit.pas svneol=native#text/plain components/lazcontrols/listfilteredit_icon.lrs svneol=native#text/plain +components/lazcontrols/lvlgraphctrl.pas svneol=native#text/plain components/lazcontrols/shortpathedit.pas svneol=native#text/plain components/lazcontrols/shortpathedit_icon.lrs svneol=native#text/plain components/lazcontrols/treefilteredit.pas svneol=native#text/plain diff --git a/components/codetools/ide/codyctrls.pas b/components/codetools/ide/codyctrls.pas index 5204f3a5d7..13f0906c5f 100644 --- a/components/codetools/ide/codyctrls.pas +++ b/components/codetools/ide/codyctrls.pas @@ -34,9 +34,6 @@ uses LazLogger, AvgLvlTree, ComCtrls, Controls, Graphics, LCLType, Forms, LCLIntf, LMessages, ImgList, GraphType, GraphMath; -type - TCodyCtrlPalette = array of TFPColor; - type { TCodyTreeView } @@ -232,716 +229,17 @@ type end; -{off $DEFINE CheckMinXGraph} -const - DefaultLvlGraphNodeImageEffect = gdeNormal; -type - TLvlGraph = class; - TLvlGraphEdge = class; - TLvlGraphLevel = class; - - { 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; - 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 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 SetVisible(AValue: boolean); - procedure UnbindLevel; - procedure SelectionChanged; - 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; - 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; - function DrawCenter: integer; - 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; - TLvlGraphNodeArray = array of TLvlGraphNode; - PLvlGraphNode = ^TLvlGraphNode; - - { TLvlGraphEdge } - - TLvlGraphEdge = class(TPersistent) - private - FBackEdge: boolean; - FDrawnAt: TRect; - FHighlighted: boolean; - FSource: TLvlGraphNode; - FTarget: TLvlGraphNode; - FWeight: single; - procedure SetHighlighted(AValue: boolean); - procedure SetWeight(AValue: single); - 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 was disabled to break a cycle - property Highlighted: boolean read FHighlighted write SetHighlighted; - property DrawnAt: TRect read FDrawnAt; // last drawn with scrolling - 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; - - 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; - FOnSelectionChanged: TNotifyEvent; - FOnStructureChanged: TOnLvlGraphStructureChanged; - function GetLevelCount: integer; - function GetLevels(Index: integer): TLvlGraphLevel; - function GetNodes(Index: integer): TLvlGraphNode; - procedure SetLevelCount(AValue: integer); - procedure InternalRemoveNode(Node: TLvlGraphNode); - procedure InternalRemoveLevel(Lvl: TLvlGraphLevel); - protected - procedure SelectionChanged; - 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; - - // edges - function GetEdge(SourceCaption, TargetCaption: string; - CreateIfNotExists: boolean): TLvlGraphEdge; - function GetEdge(Source, Target: TLvlGraphNode; - CreateIfNotExists: boolean): TLvlGraphEdge; - property EdgeClass: TLvlGraphEdgeClass read FEdgeClass; - - // levels - property Levels[Index: integer]: TLvlGraphLevel read GetLevels; - property LevelCount: integer read GetLevelCount write SetLevelCount; - property LevelClass: TLvlGraphLevelClass read FLevelClass; - - procedure CreateTopologicalLevels(HighLevels: boolean); // create levels from edges - 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 SetColors(Palette: TCodyCtrlPalette); - - // debugging - procedure WriteDebugReport(Msg: string); - procedure ConsistencyCheck(WithBackEdge: boolean); - end; - -type - TLvlGraphCtrlOption = ( - lgoAutoLayout, // automatic graph layout after graph was changed - 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, - lgoHighLevels // put nodes topologically at higher levels - ); - TLvlGraphCtrlOptions = set of TLvlGraphCtrlOption; -const - DefaultLvlGraphCtrlOptions = [lgoAutoLayout, - 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; - -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; - - TLvlGraphControlFlag = ( - lgcNeedInvalidate, - lgcNeedAutoLayout, - lgcIgnoreGraphInvalidate, - lgcUpdatingScrollBars - ); - TLvlGraphControlFlags = set of TLvlGraphControlFlag; - - TLvlGraphMinimizeOverlappingsEvent = procedure(MinPos: integer = 0; - NodeGapInFront: integer = 1; NodeGapBehind: integer = 1) 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; - 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; - 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 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); - 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 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; - 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; - // misc procedure FreeTVNodeData(TV: TCustomTreeView); -function GetCCPaletteRGB(Cnt: integer; Shuffled: boolean): TCodyCtrlPalette; -procedure ShuffleCCPalette(Palette: TCodyCtrlPalette); -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; - // diagram procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer; InnerSize: single; StartAngle16, EndAngle16: integer); overload; procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2, InnerSize, StartAngle, EndAngle: single); overload; -// level graph -procedure LvlGraphMinimizeCrossings(Graph: TLvlGraph); overload; -procedure LvlGraphHighlightNode(Node: TLvlGraphNode; - HighlightedElements: TAvgLvlTree; FollowIn, FollowOut: boolean); -function CompareLGNodesByCenterPos(Node1, Node2: Pointer): integer; -procedure DrawCurvedLvlLeftToRightEdge(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer); - -// 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; - procedure BindToSwitchList; - 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; - -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: TAvgLvlTree; - 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; - procedure FreeTVNodeData(TV: TCustomTreeView); var Node: TTreeNode; @@ -958,76 +256,6 @@ begin TV.EndUpdate; 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)LineY2)) then exit; - if (LineY1>LineY2) and ((YLineY1)) 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 (LineX1LineX2)) then exit; - if (LineX1>LineX2) and ((XLineX1)) 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 (LineX1LineX2)) then exit; - if (LineX1>LineX2) and ((lx>LineX1) or (lx'' then Result+=','; - Result+=dbgs(o); - end; - Result:='['+Result+']'; -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; - -procedure TMinXPair.BindToSwitchList; -begin - NextSameSwitchPair:=Graph.SameSwitchDiffPairs[Graph.SameSwitchDiffPair0+SwitchDiff]; - 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]; - 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 (BestCrossCountnil 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); -var - Pair: TMinXPair; -begin - while (MaxRun>0) and (BestCrossCount<>0) do begin - //debugln(['TMinXGraph.SwitchCrossingPairs ',MaxRun,' ',Run]); - Pair:=FindBestPair; - Run+=1; - if (Pair=nil) or (Pair.SwitchDiff=0) then exit; - SwitchPair(Pair); - 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+1nil 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(Node1.OutEdges[i].IndexInLevel(Node1.InEdges[i].IndexInLevelnil 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; - if TargetNode.Level.Index>Level.Index 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; -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; - Node.FDrawnCaptionRect:=Rect(x,y,x+TxtW,y+TxtH); - if Node.Selected then begin - Canvas.Brush.Style:=bsSolid; - Canvas.Brush.Color:=clHighlight; - end else begin - Canvas.Brush.Style:=bsClear; - Canvas.Brush.Color:=clNone; - end; - 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 - // 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: TCodyCtrlPalette; -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=0) and (Node.OverlayIndex 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.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)); - - 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: integer; -begin - r:=Edge.DrawnAt; - 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); - DrawCurvedLvlLeftToRightEdge(Canvas,r.Left,r.Top+s,r.Right,r.Bottom+s); - end; - end; - end else begin - case EdgeStyle.Shape of - lgesStraight: Canvas.Line(r); - lgesCurved: DrawCurvedLvlLeftToRightEdge(Canvas,r.Left,r.Top,r.Right,r.Bottom); - 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); -begin - if Assigned(OnMinimizeOverlappings) then - OnMinimizeOverlappings(MinPos,NodeGapInFront,NodeGapBehind) - else - Graph.MinimizeOverlappings(MinPos,NodeGapInFront,NodeGapBehind); -end; - -procedure TCustomLvlGraphControl.Paint; -var - w: Integer; - TxtH: integer; -begin - inherited Paint; - - Canvas.Font.Assign(Font); - - 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:=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: TAvgLvlTree; - Edge: TLvlGraphEdge; -begin - BeginUpdate; - HighlightedElements:=TAvgLvlTree.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; - -constructor TCustomLvlGraphControl.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FOptions:=DefaultLvlGraphCtrlOptions; - FGraph:=TLvlGraph.Create; - FGraph.OnInvalidate:=@GraphInvalidate; - FGraph.OnSelectionChanged:=@GraphSelectionChanged; - FGraph.OnStructureChanged:=@GraphStructureChanged; - FNodeStyle:=TLvlGraphNodeStyle.Create(Self); - FEdgeStyle:=TLvlGraphEdgeStyle.Create(Self); - FImageChangeLink := TChangeLink.Create; - FImageChangeLink.OnChange:=@ImageListChange; -end; - -destructor TCustomLvlGraphControl.Destroy; -begin - FreeAndNil(FImageChangeLink); - FreeAndNil(FGraph); - 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; - - // distribute the nodes on levels and mark back edges - Graph.CreateTopologicalLevels(lgoHighLevels in Options); - - 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; - Graph.MinimizeOverlappings(HeaderHeight,GapInFront,GapBehind); - - // 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+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.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 CurDist0 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; - -procedure TLvlGraph.SetLevelCount(AValue: integer); -begin - if AValue<1 then - raise Exception.Create('at least one level'); - if LevelCount=AValue then Exit; - while LevelCountAValue 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; -end; - -destructor TLvlGraph.Destroy; -begin - Clear; - 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; -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; - while (i>=0) and (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; -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.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; - -procedure TLvlGraph.CreateTopologicalLevels(HighLevels: boolean); -{$DEFINE LvlGraphConsistencyCheck} -var - ExtNodes: TAvgLvlTree; // 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); - var - Node: TLvlGraphNode; - e: Integer; - Edge: TLvlGraphEdge; - ExtNextNode: TGraphLevelerNode; - Cnt: Integer; - begin - if ExtNode.Visited then exit; - ExtNode.InPath:=true; - ExtNode.Visited:=true; - 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 ExtNextNode.InPath then begin - Edge.FBackEdge:=true // edge is part of a cycle - end else begin - Traverse(ExtNextNode); - ExtNode.Level:=Max(ExtNode.Level,ExtNextNode.Level+1); - end; - end; - MaxLevel:=Max(MaxLevel,ExtNode.Level); - // backtrack - ExtNode.InPath:=false; - end; - -var - i: Integer; - Node: TLvlGraphNode; - ExtNode: TGraphLevelerNode; - j: Integer; - Edge: TLvlGraphEdge; -begin - //WriteDebugReport('TLvlGraph.CreateTopologicalLevels START'); - {$IFDEF LvlGraphConsistencyCheck} - ConsistencyCheck(false); - {$ENDIF} - ExtNodes:=TAvgLvlTree.Create(@CompareGraphLevelerNodes); - try - // init ExtNodes - // clear BackEdge flags - for i:=0 to NodeCount-1 do begin - Node:=Nodes[i]; - ExtNode:=TGraphLevelerNode.Create; - ExtNode.Node:=Node; - ExtNodes.Add(ExtNode); - for j:=0 to Node.OutEdgeCount-1 do begin - Edge:=Node.OutEdges[j]; - Edge.fBackEdge:=false; - end; - end; - // traverse all nodes - MaxLevel:=0; - for i:=0 to NodeCount-1 do begin - Node:=Nodes[i]; - Traverse(GetExtNode(Node)); - 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 - Node.Level:=Levels[MaxLevel-ExtNode.Level] - 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(true); - {$ENDIF} -end; - -procedure TLvlGraph.SplitLongEdges(SplitMode: TLvlGraphEdgeSplitMode); -// replace edges over several levels into several short edges by adding hidden nodes -type - TNodeInfo = record - HiddenNodes: TLvlGraphNodeArray; - 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: TAvgLvlTreeNode; - P2PItem: PPointerToPointerItem; - MergeAtSourceNode: 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,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; - // 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 - else - HiddenNodes:=TargetInfo^.HiddenNodes; - // 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 lnil 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 - 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: TLvlGraphNode; - j: Integer; - Edge: TLvlGraphEdge; -begin - for i:=0 to NodeCount-1 do begin - Node:=Nodes[i]; - for j:=0 to Node.OutEdgeCount-1 do begin - Edge:=Node.OutEdges[j]; - Edge.fBackEdge:=Edge.IsBackEdge; - end; - end; -end; - -procedure TLvlGraph.MinimizeCrossings; -begin - LvlGraphMinimizeCrossings(Self); -end; - -procedure TLvlGraph.MinimizeOverlappings(MinPos: integer; - NodeGapAbove: integer; NodeGapBelow: integer; aLevel: integer); -var - i: 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]; - if Last=nil then - Node.DrawPosition:=MinPos+NodeGapAbove - else if Node.Visible then - Node.DrawPosition:=Max(Node.DrawPosition,Last.DrawPositionEnd+NodeGapBelow+NodeGapAbove) - else - Node.DrawPosition:=Max(Node.DrawPosition,Last.DrawPositionEnd+1); - //debugln(['TLvlGraph.MinimizeOverlappings Level=',aLevel,' Node=',Node.Caption,' Size=',Node.DrawSize,' Position=',Node.DrawPosition]); - Last:=Node; - end; - end; -end; - -procedure TLvlGraph.SetColors(Palette: TCodyCtrlPalette); -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)Node then - raise Exception.Create(''); - if Edge.Target.FInEdges.IndexOf(Edge)<0 then - raise Exception.Create(''); - if WithBackEdge and (Edge.BackEdge<>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); - 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; - -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.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 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.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.DrawCenter: integer; -begin - Result:=DrawPosition+(DrawSize div 2); -end; - -function TLvlGraphNode.DrawPositionEnd: integer; -begin - Result:=DrawPosition+DrawSize; -end; - { TCodyTreeView } procedure TCodyTreeView.FreeNodeData; diff --git a/components/codetools/ide/codyunitdepwnd.pas b/components/codetools/ide/codyunitdepwnd.pas index 36979b3b66..7029605f09 100644 --- a/components/codetools/ide/codyunitdepwnd.pas +++ b/components/codetools/ide/codyunitdepwnd.pas @@ -34,7 +34,7 @@ uses LazLogger, TreeFilterEdit, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons, ComCtrls, LCLType, LazIDEIntf, ProjectIntf, IDEWindowIntf, PackageIntf, CTUnitGraph, CodeToolManager, DefineTemplates, CTUnitGroupGraph, - CodeToolsStructs, CodyCtrls; + CodeToolsStructs, CodyCtrls, LvlGraphCtrl; const // ToDo: make resourcestring lisSelectAUnit = 'Select an unit'; diff --git a/components/lazcontrols/lazcontrols.lpk b/components/lazcontrols/lazcontrols.lpk index fea698fb10..038f22473f 100644 --- a/components/lazcontrols/lazcontrols.lpk +++ b/components/lazcontrols/lazcontrols.lpk @@ -19,7 +19,7 @@ - + @@ -43,8 +43,12 @@ - + + + + + diff --git a/components/lazcontrols/lazcontrols.pas b/components/lazcontrols/lazcontrols.pas index 0da8452da4..ad2d5c9770 100644 --- a/components/lazcontrols/lazcontrols.pas +++ b/components/lazcontrols/lazcontrols.pas @@ -8,7 +8,7 @@ interface uses DividerBevel, ExtendedNotebook, ListFilterEdit, TreeFilterEdit, - ShortPathEdit, LazarusPackageIntf; + ShortPathEdit, LvlGraphCtrl, LazarusPackageIntf; implementation diff --git a/components/lazcontrols/lvlgraphctrl.pas b/components/lazcontrols/lvlgraphctrl.pas new file mode 100644 index 0000000000..5ffa5a493e --- /dev/null +++ b/components/lazcontrols/lvlgraphctrl.pas @@ -0,0 +1,3715 @@ +{ 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 copyright. +} +unit LvlGraphCtrl; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, types, math, typinfo, + FPimage, FPCanvas, + AvgLvlTree, LazLoggerBase, LMessages, LCLType, GraphType, GraphMath, Graphics, + Controls, ImgList, LCLIntf, Forms; + +type + TLazCtrlPalette = array of TFPColor; + +{off $DEFINE CheckMinXGraph} +const + DefaultLvlGraphNodeImageEffect = gdeNormal; +type + TLvlGraph = class; + TLvlGraphEdge = class; + TLvlGraphLevel = class; + + { 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; + 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 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 SetVisible(AValue: boolean); + procedure UnbindLevel; + procedure SelectionChanged; + 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; + 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; + function DrawCenter: integer; + 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; + TLvlGraphNodeArray = array of TLvlGraphNode; + PLvlGraphNode = ^TLvlGraphNode; + + { TLvlGraphEdge } + + TLvlGraphEdge = class(TPersistent) + private + FBackEdge: boolean; + FDrawnAt: TRect; + FHighlighted: boolean; + FSource: TLvlGraphNode; + FTarget: TLvlGraphNode; + FWeight: single; + procedure SetHighlighted(AValue: boolean); + procedure SetWeight(AValue: single); + 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 was disabled to break a cycle + property Highlighted: boolean read FHighlighted write SetHighlighted; + property DrawnAt: TRect read FDrawnAt; // last drawn with scrolling + 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; + + 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; + FOnSelectionChanged: TNotifyEvent; + FOnStructureChanged: TOnLvlGraphStructureChanged; + function GetLevelCount: integer; + function GetLevels(Index: integer): TLvlGraphLevel; + function GetNodes(Index: integer): TLvlGraphNode; + procedure SetLevelCount(AValue: integer); + procedure InternalRemoveNode(Node: TLvlGraphNode); + procedure InternalRemoveLevel(Lvl: TLvlGraphLevel); + protected + procedure SelectionChanged; + 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; + + // edges + function GetEdge(SourceCaption, TargetCaption: string; + CreateIfNotExists: boolean): TLvlGraphEdge; + function GetEdge(Source, Target: TLvlGraphNode; + CreateIfNotExists: boolean): TLvlGraphEdge; + property EdgeClass: TLvlGraphEdgeClass read FEdgeClass; + + // levels + property Levels[Index: integer]: TLvlGraphLevel read GetLevels; + property LevelCount: integer read GetLevelCount write SetLevelCount; + property LevelClass: TLvlGraphLevelClass read FLevelClass; + + procedure CreateTopologicalLevels(HighLevels: boolean); // create levels from edges + 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 SetColors(Palette: TLazCtrlPalette); + + // debugging + procedure WriteDebugReport(Msg: string); + procedure ConsistencyCheck(WithBackEdge: boolean); + end; + +type + TLvlGraphCtrlOption = ( + lgoAutoLayout, // automatic graph layout after graph was changed + 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, + lgoHighLevels // put nodes topologically at higher levels + ); + TLvlGraphCtrlOptions = set of TLvlGraphCtrlOption; +const + DefaultLvlGraphCtrlOptions = [lgoAutoLayout, + 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; + +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; + + TLvlGraphControlFlag = ( + lgcNeedInvalidate, + lgcNeedAutoLayout, + lgcIgnoreGraphInvalidate, + lgcUpdatingScrollBars + ); + TLvlGraphControlFlags = set of TLvlGraphControlFlag; + + TLvlGraphMinimizeOverlappingsEvent = procedure(MinPos: integer = 0; + NodeGapInFront: integer = 1; NodeGapBehind: integer = 1) 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; + 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; + 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 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); + 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 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; + 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(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: TAvgLvlTree; FollowIn, FollowOut: boolean); +function CompareLGNodesByCenterPos(Node1, Node2: Pointer): integer; +procedure DrawCurvedLvlLeftToRightEdge(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer); + +// 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; + procedure BindToSwitchList; + 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; + +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: TAvgLvlTree; + 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)LineY2)) then exit; + if (LineY1>LineY2) and ((YLineY1)) 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 (LineX1LineX2)) then exit; + if (LineX1>LineX2) and ((XLineX1)) 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 (LineX1LineX2)) then exit; + if (LineX1>LineX2) and ((lx>LineX1) or (lx'' then Result+=','; + Result+=dbgs(o); + end; + Result:='['+Result+']'; +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; + +procedure TMinXPair.BindToSwitchList; +begin + NextSameSwitchPair:=Graph.SameSwitchDiffPairs[Graph.SameSwitchDiffPair0+SwitchDiff]; + 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]; + 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 (BestCrossCountnil 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); +var + Pair: TMinXPair; +begin + while (MaxRun>0) and (BestCrossCount<>0) do begin + //debugln(['TMinXGraph.SwitchCrossingPairs ',MaxRun,' ',Run]); + Pair:=FindBestPair; + Run+=1; + if (Pair=nil) or (Pair.SwitchDiff=0) then exit; + SwitchPair(Pair); + 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+1nil 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(Node1.OutEdges[i].IndexInLevel(Node1.InEdges[i].IndexInLevelnil 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; + if TargetNode.Level.Index>Level.Index 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; +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; + Node.FDrawnCaptionRect:=Rect(x,y,x+TxtW,y+TxtH); + if Node.Selected then begin + Canvas.Brush.Style:=bsSolid; + Canvas.Brush.Color:=clHighlight; + end else begin + Canvas.Brush.Style:=bsClear; + Canvas.Brush.Color:=clNone; + end; + 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 + // 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=0) and (Node.OverlayIndex 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.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)); + + 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: integer; +begin + r:=Edge.DrawnAt; + 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); + DrawCurvedLvlLeftToRightEdge(Canvas,r.Left,r.Top+s,r.Right,r.Bottom+s); + end; + end; + end else begin + case EdgeStyle.Shape of + lgesStraight: Canvas.Line(r); + lgesCurved: DrawCurvedLvlLeftToRightEdge(Canvas,r.Left,r.Top,r.Right,r.Bottom); + 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); +begin + if Assigned(OnMinimizeOverlappings) then + OnMinimizeOverlappings(MinPos,NodeGapInFront,NodeGapBehind) + else + Graph.MinimizeOverlappings(MinPos,NodeGapInFront,NodeGapBehind); +end; + +procedure TCustomLvlGraphControl.Paint; +var + w: Integer; + TxtH: integer; +begin + inherited Paint; + + Canvas.Font.Assign(Font); + + 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:=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: TAvgLvlTree; + Edge: TLvlGraphEdge; +begin + BeginUpdate; + HighlightedElements:=TAvgLvlTree.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; + +constructor TCustomLvlGraphControl.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FOptions:=DefaultLvlGraphCtrlOptions; + FGraph:=TLvlGraph.Create; + FGraph.OnInvalidate:=@GraphInvalidate; + FGraph.OnSelectionChanged:=@GraphSelectionChanged; + FGraph.OnStructureChanged:=@GraphStructureChanged; + FNodeStyle:=TLvlGraphNodeStyle.Create(Self); + FEdgeStyle:=TLvlGraphEdgeStyle.Create(Self); + FImageChangeLink := TChangeLink.Create; + FImageChangeLink.OnChange:=@ImageListChange; +end; + +destructor TCustomLvlGraphControl.Destroy; +begin + FreeAndNil(FImageChangeLink); + FreeAndNil(FGraph); + 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; + + // distribute the nodes on levels and mark back edges + Graph.CreateTopologicalLevels(lgoHighLevels in Options); + + 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; + Graph.MinimizeOverlappings(HeaderHeight,GapInFront,GapBehind); + + // 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+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.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 CurDist0 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; + +procedure TLvlGraph.SetLevelCount(AValue: integer); +begin + if AValue<1 then + raise Exception.Create('at least one level'); + if LevelCount=AValue then Exit; + while LevelCountAValue 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; +end; + +destructor TLvlGraph.Destroy; +begin + Clear; + 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; +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; + while (i>=0) and (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; +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.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; + +procedure TLvlGraph.CreateTopologicalLevels(HighLevels: boolean); +{$DEFINE LvlGraphConsistencyCheck} +var + ExtNodes: TAvgLvlTree; // 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); + var + Node: TLvlGraphNode; + e: Integer; + Edge: TLvlGraphEdge; + ExtNextNode: TGraphLevelerNode; + Cnt: Integer; + begin + if ExtNode.Visited then exit; + ExtNode.InPath:=true; + ExtNode.Visited:=true; + 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 ExtNextNode.InPath then begin + Edge.FBackEdge:=true // edge is part of a cycle + end else begin + Traverse(ExtNextNode); + ExtNode.Level:=Max(ExtNode.Level,ExtNextNode.Level+1); + end; + end; + MaxLevel:=Max(MaxLevel,ExtNode.Level); + // backtrack + ExtNode.InPath:=false; + end; + +var + i: Integer; + Node: TLvlGraphNode; + ExtNode: TGraphLevelerNode; + j: Integer; + Edge: TLvlGraphEdge; +begin + //WriteDebugReport('TLvlGraph.CreateTopologicalLevels START'); + {$IFDEF LvlGraphConsistencyCheck} + ConsistencyCheck(false); + {$ENDIF} + ExtNodes:=TAvgLvlTree.Create(@CompareGraphLevelerNodes); + try + // init ExtNodes + // clear BackEdge flags + for i:=0 to NodeCount-1 do begin + Node:=Nodes[i]; + ExtNode:=TGraphLevelerNode.Create; + ExtNode.Node:=Node; + ExtNodes.Add(ExtNode); + for j:=0 to Node.OutEdgeCount-1 do begin + Edge:=Node.OutEdges[j]; + Edge.fBackEdge:=false; + end; + end; + // traverse all nodes + MaxLevel:=0; + for i:=0 to NodeCount-1 do begin + Node:=Nodes[i]; + Traverse(GetExtNode(Node)); + 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 + Node.Level:=Levels[MaxLevel-ExtNode.Level] + 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(true); + {$ENDIF} +end; + +procedure TLvlGraph.SplitLongEdges(SplitMode: TLvlGraphEdgeSplitMode); +// replace edges over several levels into several short edges by adding hidden nodes +type + TNodeInfo = record + HiddenNodes: TLvlGraphNodeArray; + 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: TAvgLvlTreeNode; + P2PItem: PPointerToPointerItem; + MergeAtSourceNode: 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,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; + // 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 + else + HiddenNodes:=TargetInfo^.HiddenNodes; + // 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 lnil 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 + 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: TLvlGraphNode; + j: Integer; + Edge: TLvlGraphEdge; +begin + for i:=0 to NodeCount-1 do begin + Node:=Nodes[i]; + for j:=0 to Node.OutEdgeCount-1 do begin + Edge:=Node.OutEdges[j]; + Edge.fBackEdge:=Edge.IsBackEdge; + end; + end; +end; + +procedure TLvlGraph.MinimizeCrossings; +begin + LvlGraphMinimizeCrossings(Self); +end; + +procedure TLvlGraph.MinimizeOverlappings(MinPos: integer; + NodeGapAbove: integer; NodeGapBelow: integer; aLevel: integer); +var + i: 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]; + if Last=nil then + Node.DrawPosition:=MinPos+NodeGapAbove + else if Node.Visible then + Node.DrawPosition:=Max(Node.DrawPosition,Last.DrawPositionEnd+NodeGapBelow+NodeGapAbove) + else + Node.DrawPosition:=Max(Node.DrawPosition,Last.DrawPositionEnd+1); + //debugln(['TLvlGraph.MinimizeOverlappings Level=',aLevel,' Node=',Node.Caption,' Size=',Node.DrawSize,' Position=',Node.DrawPosition]); + Last:=Node; + end; + end; +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)Node then + raise Exception.Create(''); + if Edge.Target.FInEdges.IndexOf(Edge)<0 then + raise Exception.Create(''); + if WithBackEdge and (Edge.BackEdge<>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); + 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; + +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.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 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.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.DrawCenter: integer; +begin + Result:=DrawPosition+(DrawSize div 2); +end; + +function TLvlGraphNode.DrawPositionEnd: integer; +begin + Result:=DrawPosition+DrawSize; +end; + +end. +