{ LvlGraphCtrl Copyright (C) 2013 Lazarus team This library is free software; you can redistribute it and/or modify it under the same terms as the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. } unit LvlGraphCtrl; {$mode objfpc}{$H+} interface uses Classes, SysUtils, types, math, typinfo, FPimage, FPCanvas, AvgLvlTree, LazLoggerBase, LMessages, LCLType, LResources, GraphType, GraphMath, Graphics, Controls, ImgList, LCLIntf, Forms, Themes; type TLazCtrlPalette = array of TFPColor; {off $DEFINE CheckMinXGraph} const DefaultLvlGraphNodeImageEffect = gdeNormal; type TLvlGraph = class; TLvlGraphEdge = class; TLvlGraphLevel = class; TLvlGraphNode = class; TLvlGraphNodeArray = array of TLvlGraphNode; { TLvlGraphNode } TLvlGraphNode = class(TPersistent) private FCaption: string; FColor: TFPColor; FDrawnCaptionRect: TRect; FGraph: TLvlGraph; FImageEffect: TGraphicsDrawEffect; FImageIndex: integer; FInEdges: TFPList; // list of TLvlGraphEdge FDrawSize: integer; FInWeight: single; FLevel: TLvlGraphLevel; FNextSelected: TLvlGraphNode; FOutEdges: TFPList; // list of TLvlGraphEdge FDrawPosition: integer; FOutWeight: single; FOverlayIndex: integer; FPrevSelected: TLvlGraphNode; FSelected: boolean; 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; function GetVisibleSourceNodes: TLvlGraphNodeArray; function GetVisibleSourceNodesAsAVLTree: TAvgLvlTree; function GetVisibleTargetNodes: TLvlGraphNodeArray; function GetVisibleTargetNodesAsAVLTree: TAvgLvlTree; 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; 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 GetVisibleSourceNodes: TLvlGraphNodeArray; function GetVisibleSourceNodesAsAVLTree: TAvgLvlTree; function GetVisibleTargetNodes: TLvlGraphNodeArray; function GetVisibleTargetNodesAsAVLTree: TAvgLvlTree; 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 lgoHighLevels, // put nodes topologically at higher levels lgoHighlightNodeUnderMouse, // when mouse over node highlight node and its edges lgoHighlightEdgeNearMouse, // when mouse near an edge highlight edge and its edges, lgoHighlightNodeUnderMouse takes precedence lgoMouseSelects ); TLvlGraphCtrlOptions = set of TLvlGraphCtrlOption; const DefaultLvlGraphCtrlOptions = [lgoAutoLayout, 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, lgcFocusedPainting ); 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; function GetSelectedNode: TLvlGraphNode; procedure SetEdgeNearMouse(AValue: TLvlGraphEdge); procedure SetImages(AValue: TCustomImageList); procedure SetNodeStyle(AValue: TLvlGraphNodeStyle); procedure SetNodeUnderMouse(AValue: TLvlGraphNode); procedure SetOptions(AValue: TLvlGraphCtrlOptions); procedure SetScrollLeft(AValue: integer); procedure SetScrollTop(AValue: integer); procedure SetSelectedNode(AValue: TLvlGraphNode); procedure UpdateScrollBars; procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL; procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL; procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL; procedure ImageListChange(Sender: TObject); protected procedure GraphInvalidate(Sender: TObject); virtual; procedure GraphSelectionChanged(Sender: TObject); virtual; procedure GraphStructureChanged(Sender, Element: TObject; Operation: TOperation); virtual; procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; procedure DoStartAutoLayout; virtual; procedure DoMinimizeCrossings; virtual; procedure DoAutoLayoutLevels(TxtHeight: integer); virtual; procedure DoMinimizeOverlappings(MinPos: integer = 0; NodeGapInFront: integer = 1; NodeGapBehind: integer = 1); virtual; procedure DoEndAutoLayout; virtual; procedure DoDrawEdge(Edge: TLvlGraphEdge); virtual; // draw line at Edge.DrawX1,Y1,X2,Y2 with current Canvas colors procedure Paint; override; function Draw(Step: TLvlGraphDrawStep): boolean; virtual; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override; procedure CreateWnd; override; procedure HighlightConnectedEgdes(Element: TObject); procedure DoOnShowHint(HintInfo: PHintInfo); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure EraseBackground({%H-}DC: HDC); override; property Graph: TLvlGraph read FGraph; procedure Clear; procedure AutoLayout; virtual; procedure Invalidate; override; procedure InvalidateAutoLayout; procedure BeginUpdate; procedure EndUpdate; function GetNodeAt(X,Y: integer): TLvlGraphNode; function GetEdgeAt(X,Y: integer; out Distance: integer): TLvlGraphEdge; class function GetControlClassDefaultSize: TSize; override; function GetDrawSize: TPoint; public property NodeStyle: TLvlGraphNodeStyle read FNodeStyle write SetNodeStyle; property NodeUnderMouse: TLvlGraphNode read FNodeUnderMouse write SetNodeUnderMouse; property EdgeNearMouse: TLvlGraphEdge read FEdgeNearMouse write SetEdgeNearMouse; property EdgeStyle: TLvlGraphEdgeStyle read FEdgeStyle; property Options: TLvlGraphCtrlOptions read FOptions write SetOptions default DefaultLvlGraphCtrlOptions; property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged; property ScrollTop: integer read FScrollTop write SetScrollTop; property ScrollTopMax: integer read FScrollTopMax; property ScrollLeft: integer read FScrollLeft write SetScrollLeft; property ScrollLeftMax: integer read FScrollLeftMax; property OnMinimizeCrossings: TNotifyEvent read FOnMinimizeCrossings write FOnMinimizeCrossings;// provide an alternative minimize crossing algorithm property OnMinimizeOverlappings: TLvlGraphMinimizeOverlappingsEvent read FOnMinimizeOverlappings write FOnMinimizeOverlappings;// provide an alternative minimize overlappings algorithm property OnStartAutoLayout: TNotifyEvent read FOnStartAutoLayout write FOnStartAutoLayout; property OnEndAutoLayout: TNotifyEvent read FOnEndAutoLayout write FOnEndAutoLayout; property OnDrawStep: TLvlGraphDrawEvent read FOnDrawStep write FOnDrawStep; property Images: TCustomImageList read FImages write SetImages; property PixelPerWeight: single read FPixelPerWeight; property SelectedNode: TLvlGraphNode read GetSelectedNode write SetSelectedNode; property ShowHint default True; end; { TLvlGraphControl } TLvlGraphControl = class(TCustomLvlGraphControl) published property Align; property Anchors; property BorderSpacing; property BorderStyle; property BorderWidth; property Color; property Constraints; property DragCursor; property DragKind; property DragMode; property EdgeStyle; property Enabled; property Font; property NodeStyle; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawStep; property OnEndAutoLayout; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMinimizeCrossings; property OnMinimizeOverlappings; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnSelectionChanged; property OnShowHint; property OnStartAutoLayout; property OnStartDrag; property OnUTF8KeyPress; property Options; property ParentColor default False; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop default True; property Tag; property Visible; end; function GetCCPaletteRGB(Cnt: integer; Shuffled: boolean): TLazCtrlPalette; procedure ShuffleCCPalette({%H-}Palette: TLazCtrlPalette); function Darker(const c: TColor): TColor; overload; function GetManhattanDistancePointLine(X,Y, LineX1, LineY1, LineX2, LineY2: integer): integer; function GetDistancePointLine(X,Y, LineX1, LineY1, LineX2, LineY2: integer): integer; function GetDistancePointPoint(X1,Y1,X2,Y2: integer): integer; // level graph procedure LvlGraphMinimizeCrossings(Graph: TLvlGraph); overload; procedure LvlGraphHighlightNode(Node: TLvlGraphNode; HighlightedElements: TAvgLvlTree; FollowIn, FollowOut: boolean); function CompareLGNodesByCenterPos(Node1, Node2: Pointer): integer; procedure DrawCurvedLvlLeftToRightEdge(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer); function NodeAVLTreeToNodeArray(Nodes: TAvgLvlTree; RemoveHidden: boolean; FreeTree: boolean): TLvlGraphNodeArray; function NodeArrayAsString(Nodes: TLvlGraphNodeArray): String; // debugging function dbgs(p: TLvlGraphNodeCaptionPosition): string; overload; function dbgs(o: TLvlGraphCtrlOption): string; overload; function dbgs(Options: TLvlGraphCtrlOptions): string; overload; implementation type TMinXGraph = class; TMinXLevel = class; TMinXPair = class; { TMinXNode } TMinXNode = class public GraphNode: TLvlGraphNode; InEdges, OutEdges: array of TMinXNode; Level: TMinXLevel; IndexInLevel: integer; constructor Create(aNode: TLvlGraphNode); destructor Destroy; override; end; { TMinXLevel } TMinXLevel = class public Index: integer; Graph: TMinXGraph; GraphLevel: TLvlGraphLevel; Nodes: array of TMinXNode; Pairs: array of TMinXPair; BestNodes: TLvlGraphNodeArray; constructor Create(aGraph: TMinXGraph; aIndex: integer); destructor Destroy; override; procedure GetCrossingCount(Node1, Node2: TMinXNode; out Crossing, SwitchCrossing: integer); end; { TMinXPair } TMinXPair = class private FSwitchDiff: integer; // change of crossings when the two nodes would switch procedure SetSwitchDiff(AValue: integer); public Level: TMinXLevel; Graph: TMinXGraph; Index: integer; PrevSameSwitchPair, NextSameSwitchPair: TMinXPair; constructor Create(aLevel: TMinXLevel; aIndex: integer); destructor Destroy; override; procedure UnbindFromSwitchList; 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 (lx0 then Result+=', '; Result+=Nodes[i].Caption; end; end; function dbgs(p: TLvlGraphNodeCaptionPosition): string; begin Result:=GetEnumName(typeinfo(p),ord(p)); end; function dbgs(o: TLvlGraphCtrlOption): string; begin Result:=GetEnumName(typeinfo(o),ord(o)); end; function dbgs(Options: TLvlGraphCtrlOptions): string; var o: TLvlGraphCtrlOption; begin Result:=''; for o:=Low(TLvlGraphCtrlOption) to high(TLvlGraphCtrlOption) do if o in Options then begin if Result<>'' then Result+=','; Result+=dbgs(o); end; Result:='['+Result+']'; end; { 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; Details: TThemedElementDetails; NodeRect: TRect; begin Canvas.Font.Height:=round(single(TxtH)*NodeStyle.CaptionScale+0.5); for i:=0 to Graph.LevelCount-1 do begin Level:=Graph.Levels[i]; for j:=0 to Level.Count-1 do begin Node:=Level.Nodes[j]; if (Node.Caption='') or (not Node.Visible) then continue; TxtW:=Canvas.TextWidth(Node.Caption); case NodeStyle.CaptionPosition of lgncLeft,lgncRight: p.y:=Node.DrawCenter-(TxtH div 2); lgncTop: p.y:=Node.DrawPosition-NodeStyle.GapTop-TxtH; lgncBottom: p.y:=Node.DrawPositionEnd+NodeStyle.GapBottom; end; case NodeStyle.CaptionPosition of lgncLeft: p.x:=Level.DrawPosition-NodeStyle.GapLeft-TxtW; lgncRight: p.x:=Level.DrawPosition+NodeStyle.Width+NodeStyle.GapRight; lgncTop,lgncBottom: p.x:=Level.DrawPosition+((NodeStyle.Width-TxtW) div 2); end; //debugln(['TCustomLvlGraphControl.Paint ',Node.Caption,' DrawPosition=',Node.DrawPosition,' DrawSize=',Node.DrawSize,' TxtH=',TxtH,' TxtW=',TxtW,' p=',dbgs(p),' Selected=',Node.Selected]); x:=p.x-ScrollLeft; y:=p.y-ScrollTop; NodeRect:=Bounds(x,y,TxtW,TxtH); Node.FDrawnCaptionRect:=NodeRect; if Node.Selected then begin if lgcFocusedPainting in FFlags then Details := ThemeServices.GetElementDetails(ttItemSelected) else Details := ThemeServices.GetElementDetails(ttItemSelectedNotFocus); ThemeServices.DrawElement(Canvas.Handle, Details, NodeRect, nil); end else begin Details := ThemeServices.GetElementDetails(ttItemNormal); //Canvas.Brush.Style:=bsClear; //Canvas.Brush.Color:=clNone; end; ThemeServices.DrawText(Canvas, Details, Node.Caption, NodeRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX, 0) //Canvas.TextOut(x,y,Node.Caption); end; end; end; procedure TCustomLvlGraphControl.ComputeEdgeCoords; var l: Integer; Level: TLvlGraphLevel; n: Integer; Node: TLvlGraphNode; e: Integer; Edge: TLvlGraphEdge; TargetNode: TLvlGraphNode; x1: Integer; x2: Integer; TotalWeight, Weight: Single; Start: Integer; begin for l:=0 to Graph.LevelCount-1 do begin Level:=Graph.Levels[l]; for n:=0 to Level.Count-1 do begin Node:=Level.Nodes[n]; // out edges TotalWeight:=Node.OutWeight; Weight:=0.0; Start:=Node.DrawCenter-ScrollTop-integer(round(TotalWeight*PixelPerWeight) div 2); for e:=0 to Node.OutEdgeCount-1 do begin Edge:=Node.OutEdges[e]; Edge.FDrawnAt.Top:=Start+round(Weight*PixelPerWeight); Weight+=Edge.Weight; end; // in edges TotalWeight:=Node.InWeight; Weight:=0.0; Start:=Node.DrawCenter-ScrollTop-integer(round(TotalWeight*PixelPerWeight) div 2); for e:=0 to Node.InEdgeCount-1 do begin Edge:=Node.InEdges[e]; Edge.FDrawnAt.Bottom:=Start+round(Weight*PixelPerWeight); Weight+=Edge.Weight; end; // x1, x2 for e:=0 to Node.OutEdgeCount-1 do begin Edge:=Node.OutEdges[e]; TargetNode:=Edge.Target; x1:=Level.DrawPosition-ScrollLeft; x2:=TargetNode.Level.DrawPosition-ScrollLeft; if TargetNode.Level.Index>Level.Index then begin // normal dependency // => draw line from right of Node to left of TargetNode if Node.Visible then x1+=NodeStyle.Width else x1+=NodeStyle.Width div 2; if not TargetNode.Visible then x2+=NodeStyle.Width div 2; end else begin // 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.SetSelectedNode(AValue: TLvlGraphNode); begin if AValue=nil then Graph.ClearSelection else Graph.SingleSelect(AValue); end; procedure TCustomLvlGraphControl.UpdateScrollBars; var ScrollInfo: TScrollInfo; DrawSize: TPoint; begin if HandleAllocated and (not (lgcUpdatingScrollBars in FFlags)) then begin Include(FFlags,lgcUpdatingScrollBars); DrawSize:=GetDrawSize; FScrollTopMax:=DrawSize.Y-ClientHeight+2*BorderWidth; FScrollTop:=Max(0,Min(FScrollTop,ScrollTopMax)); FScrollLeftMax:=DrawSize.X-ClientWidth+2*BorderWidth; FScrollLeft:=Max(0,Min(FScrollLeft,ScrollLeftMax)); //debugln(['TCustomLvlGraphControl.UpdateScrollBars ',dbgs(DrawSize),' ClientRect=',dbgs(ClientRect),' ScrollLeft=',ScrollLeft,'/',ScrollLeftMax,' ScrollTop=',ScrollTop,'/',ScrollTopMax,' ']); // vertical scrollbar ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL; ScrollInfo.nMin := 0; ScrollInfo.nTrackPos := 0; ScrollInfo.nMax := DrawSize.Y; ScrollInfo.nPage := Max(1,ClientHeight-1); ScrollInfo.nPos := ScrollTop; ShowScrollBar(Handle, SB_VERT, True); SetScrollInfo(Handle, SB_VERT, ScrollInfo, True); // horizontal scrollbar ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL; ScrollInfo.nMin := 0; ScrollInfo.nTrackPos := 0; ScrollInfo.nMax := DrawSize.X; ScrollInfo.nPage := Max(1,ClientWidth-1); ScrollInfo.nPos := ScrollLeft; ShowScrollBar(Handle, SB_Horz, True); SetScrollInfo(Handle, SB_Horz, ScrollInfo, True); Exclude(FFlags,lgcUpdatingScrollBars); end; end; procedure TCustomLvlGraphControl.WMHScroll(var Msg: TLMScroll); begin case Msg.ScrollCode of SB_TOP: ScrollLeft := 0; SB_BOTTOM: ScrollLeft := ScrollLeftMax; SB_LINEDOWN: ScrollLeft := ScrollLeft + NodeStyle.Width div 2; SB_LINEUP: ScrollLeft := ScrollLeft - NodeStyle.Width div 2; SB_PAGEDOWN: ScrollLeft := ScrollLeft + ClientWidth - NodeStyle.Width; SB_PAGEUP: ScrollLeft := ScrollLeft - ClientWidth + NodeStyle.Width; SB_THUMBPOSITION, SB_THUMBTRACK: ScrollLeft := Msg.Pos; SB_ENDSCROLL: SetCaptureControl(nil); // release scrollbar capture end; end; procedure TCustomLvlGraphControl.WMVScroll(var Msg: TLMScroll); begin case Msg.ScrollCode of SB_TOP: ScrollTop := 0; SB_BOTTOM: ScrollTop := ScrollTopMax; SB_LINEDOWN: ScrollTop := ScrollTop + NodeStyle.Width div 2; SB_LINEUP: ScrollTop := ScrollTop - NodeStyle.Width div 2; SB_PAGEDOWN: ScrollTop := ScrollTop + ClientHeight - NodeStyle.Width; SB_PAGEUP: ScrollTop := ScrollTop - ClientHeight + NodeStyle.Width; SB_THUMBPOSITION, SB_THUMBTRACK: ScrollTop := Msg.Pos; SB_ENDSCROLL: SetCaptureControl(nil); // release scrollbar capture end; end; procedure TCustomLvlGraphControl.WMMouseWheel(var Message: TLMMouseEvent); begin if Mouse.WheelScrollLines=-1 then begin // -1 : scroll by page ScrollTop := ScrollTop - (Message.WheelDelta * (ClientHeight - NodeStyle.Width)) div 120; end else begin // scrolling one line -> scroll half an item, see SB_LINEDOWN and SB_LINEUP // handler in WMVScroll ScrollTop := ScrollTop - (Message.WheelDelta * Mouse.WheelScrollLines*NodeStyle.Width) div 240; end; Message.Result := 1; end; procedure TCustomLvlGraphControl.DoAutoLayoutLevels(TxtHeight: integer); // compute all Levels.DrawPosition var j: Integer; p: Integer; i: Integer; LevelTxtWidths: array of integer; Level: TLvlGraphLevel; begin Canvas.Font.Height:=round(single(TxtHeight)*NodeStyle.CaptionScale+0.5); if Graph.LevelCount=0 then exit; SetLength(LevelTxtWidths,Graph.LevelCount); for i:=0 to Graph.LevelCount-1 do begin // compute needed width of the level Level:=Graph.Levels[i]; LevelTxtWidths[i]:=Max(NodeStyle.Width,Canvas.TextWidth('NodeX'+StringOfChar('j',Min(20,Level.Count)))); for j:=0 to Level.Count-1 do if Level[j].Visible then LevelTxtWidths[i]:=Max(LevelTxtWidths[i], Canvas.TextWidth(Level[j].Caption)); p:=0; // Prevent compiler warning. if i=0 then begin // first level case NodeStyle.CaptionPosition of lgncLeft: p:=NodeStyle.GapRight+LevelTxtWidths[0]+NodeStyle.GapLeft; lgncRight: p:=NodeStyle.GapLeft; lgncTop,lgncBottom: p:=NodeStyle.GapLeft+((LevelTxtWidths[0]-NodeStyle.Width) div 2); end; end else begin // following level p:=Graph.Levels[i-1].DrawPosition; case NodeStyle.CaptionPosition of lgncLeft: p+=NodeStyle.Width+NodeStyle.GapRight+LevelTxtWidths[i]+NodeStyle.GapLeft; lgncRight: p+=NodeStyle.Width+NodeStyle.GapRight+LevelTxtWidths[i-1]+NodeStyle.GapLeft; lgncTop,lgncBottom: p+=((LevelTxtWidths[i-1]+LevelTxtWidths[i]) div 2)+NodeStyle.GapRight+NodeStyle.GapLeft; end; end; Graph.Levels[i].DrawPosition:=p; end; SetLength(LevelTxtWidths,0); end; procedure TCustomLvlGraphControl.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); begin inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); UpdateScrollBars; end; procedure TCustomLvlGraphControl.DoStartAutoLayout; begin if Assigned(OnStartAutoLayout) then OnStartAutoLayout(Self); end; procedure TCustomLvlGraphControl.DoEndAutoLayout; begin if Assigned(OnEndAutoLayout) then OnEndAutoLayout(Self); end; procedure TCustomLvlGraphControl.DoDrawEdge(Edge: TLvlGraphEdge); var r: TRect; s: 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); Include(FFlags,lgcFocusedPainting); if (lgoAutoLayout in FOptions) and (lgcNeedAutoLayout in FFlags) then begin Include(FFlags,lgcIgnoreGraphInvalidate); try AutoLayout; finally Exclude(FFlags,lgcIgnoreGraphInvalidate); end; end; // background if Draw(lgdsBackground) then begin Canvas.Brush.Style:=bsSolid; Canvas.Brush.Color:=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; procedure TCustomLvlGraphControl.DoOnShowHint(HintInfo: PHintInfo); var s: String; begin if NodeUnderMouse<>nil then begin s:=NodeArrayAsString(NodeUnderMouse.GetVisibleSourceNodes); s+=#13'->'#13; s+=NodeUnderMouse.Caption; s+=#13'->'#13; s+=NodeArrayAsString(NodeUnderMouse.GetVisibleTargetNodes); HintInfo^.HintStr:=s; end else if EdgeNearMouse<>nil then begin s:=NodeArrayAsString(EdgeNearMouse.GetVisibleSourceNodes); s+=#13'->'#13; s+=NodeArrayAsString(EdgeNearMouse.GetVisibleTargetNodes); HintInfo^.HintStr:=s; end; inherited DoOnShowHint(HintInfo); end; constructor TCustomLvlGraphControl.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle:=ControlStyle+[csAcceptsControls]; 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; ShowHint:=true; end; destructor TCustomLvlGraphControl.Destroy; begin inc(fUpdateLock); FreeAndNil(FImageChangeLink); FGraph.OnInvalidate:=nil; FGraph.OnSelectionChanged:=nil; FGraph.OnStructureChanged:=nil; FGraph.Free; FGraph:=nil; 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; while LastSelected<>Node do LastSelected.Selected:=false; end; function TLvlGraph.IsMultiSelection: boolean; begin Result:=(FirstSelected<>nil) and (FirstSelected.NextSelected<>nil); end; function TLvlGraph.GetEdge(SourceCaption, TargetCaption: string; CreateIfNotExists: boolean): TLvlGraphEdge; var Source: TLvlGraphNode; Target: TLvlGraphNode; begin Source:=GetNode(SourceCaption,CreateIfNotExists); if Source=nil then exit(nil); Target:=GetNode(TargetCaption,CreateIfNotExists); if Target=nil then exit(nil); Result:=GetEdge(Source,Target,CreateIfNotExists); end; function TLvlGraph.GetEdge(Source, Target: TLvlGraphNode; CreateIfNotExists: boolean): TLvlGraphEdge; begin Result:=Source.FindOutEdge(Target); if Result<>nil then exit; if CreateIfNotExists then begin Result:=FEdgeClass.Create(Source,Target); StructureChanged(Result,opInsert); end; end; procedure TLvlGraph.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 // ToDo: Node is probably uninitialized. LvlWeight+=Max(Node.InWeight,Node.OutWeight); Gap+=NodeGapAbove+NodeGapBelow; end; if LvlWeight=0.0 then continue; DrawHeight:=Max(1,HardMaxTotal-Gap); PixelPerWeight:=single(DrawHeight)/LvlWeight; if (MaxPixelPerWeight=0.0) or (MaxPixelPerWeight>PixelPerWeight) then MaxPixelPerWeight:=PixelPerWeight; DrawHeight:=Max(1,SoftMaxTotal-Gap); PixelPerWeight:=single(DrawHeight)/LvlWeight; if (PrefMaxPixelPerWeight=0.0) or (PrefMaxPixelPerWeight>PixelPerWeight) then PrefMaxPixelPerWeight:=PixelPerWeight; end; //debugln(['TLvlGraph.ScaleNodeDrawSizes MaxPixelPerWeight=',MaxPixelPerWeight,' PrefMaxPixelPerWeight=',PrefMaxPixelPerWeight]); PixelPerWeight:=PrefMinPixelPerWeight; if PrefMaxPixelPerWeight>0.0 then PixelPerWeight:=Min(PixelPerWeight,PrefMaxPixelPerWeight); PixelPerWeight:=Max(PixelPerWeight,MinPixelPerWeight); if MaxPixelPerWeight>0.0 then PixelPerWeight:=Min(PixelPerWeight,MaxPixelPerWeight); //debugln(['TLvlGraph.ScaleNodeDrawSizes PixelPerWeight=',PixelPerWeight]); SetAllNodeDrawSizes(PixelPerWeight,SmallestWeight); end; procedure TLvlGraph.SetAllNodeDrawSizes(PixelPerWeight: single; MinWeight: single); var i: Integer; Node: TLvlGraphNode; begin for i:=0 to NodeCount-1 do begin Node:=Nodes[i]; Node.DrawSize:=round(Max(MinWeight,Max(Node.InWeight,Node.OutWeight))*PixelPerWeight+0.5); end; end; procedure TLvlGraph.MarkBackEdges; var i: Integer; Node: 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.GetVisibleSourceNodes: TLvlGraphNodeArray; // return all visible nodes connected in Source direction begin Result:=NodeAVLTreeToNodeArray(GetVisibleSourceNodesAsAVLTree,true,true); end; function TLvlGraphEdge.GetVisibleSourceNodesAsAVLTree: TAvgLvlTree; // return all visible nodes connected in Source direction var Visited: TAvgLvlTree; procedure Search(Node: TLvlGraphNode); var i: Integer; begin if Node=nil then exit; if Visited.Find(Node)<>nil then exit; Visited.Add(Node); if Node.Visible then begin Result.Add(Node); end else begin for i:=0 to Node.InEdgeCount-1 do Search(Node.InEdges[i].Source); end; end; begin Result:=TAvgLvlTree.Create; Visited:=TAvgLvlTree.Create; try Search(Source); finally Visited.Free; end; end; function TLvlGraphEdge.GetVisibleTargetNodes: TLvlGraphNodeArray; // return all visible nodes connected in Target direction begin Result:=NodeAVLTreeToNodeArray(GetVisibleTargetNodesAsAVLTree,true,true); end; function TLvlGraphEdge.GetVisibleTargetNodesAsAVLTree: TAvgLvlTree; // return all visible nodes connected in Target direction var Visited: TAvgLvlTree; procedure Search(Node: TLvlGraphNode); var i: Integer; begin if Node=nil then exit; if Visited.Find(Node)<>nil then exit; Visited.Add(Node); if Node.Visible then begin Result.Add(Node); end else begin for i:=0 to Node.OutEdgeCount-1 do Search(Node.OutEdges[i].Target); end; end; begin Result:=TAvgLvlTree.Create; Visited:=TAvgLvlTree.Create; try Search(Source); finally Visited.Free; end; end; function TLvlGraphEdge.AsString: string; begin Result:='('+Source.Caption+'->'+Target.Caption+')'; end; { TLvlGraphNode } function TLvlGraphNode.InEdgeCount: integer; begin Result:=FInEdges.Count; end; function TLvlGraphNode.GetInEdges(Index: integer): TLvlGraphEdge; begin Result:=TLvlGraphEdge(FInEdges[Index]); end; function TLvlGraphNode.GetIndexInLevel: integer; begin if Level=nil then exit(-1); Result:=Level.IndexOf(Self); end; function TLvlGraphNode.GetOutEdges(Index: integer): TLvlGraphEdge; begin Result:=TLvlGraphEdge(FOutEdges[Index]); end; procedure TLvlGraphNode.SetCaption(AValue: string); begin if FCaption=AValue then Exit; FCaption:=AValue; Invalidate; end; procedure TLvlGraphNode.SetColor(AValue: TFPColor); begin if FColor=AValue then Exit; FColor:=AValue; Invalidate; end; procedure TLvlGraphNode.OnLevelDestroy; begin if Level.Index>0 then Level:=Graph.Levels[0] else if Graph.LevelCount>1 then Level:=Graph.Levels[1] else fLevel:=nil; end; procedure TLvlGraphNode.SetDrawSize(AValue: integer); begin if FDrawSize=AValue then Exit; FDrawSize:=AValue; Invalidate; end; procedure TLvlGraphNode.SetImageEffect(AValue: TGraphicsDrawEffect); begin if FImageEffect=AValue then Exit; FImageEffect:=AValue; Invalidate; end; procedure TLvlGraphNode.SetImageIndex(AValue: integer); begin if FImageIndex=AValue then Exit; FImageIndex:=AValue; Invalidate; end; procedure TLvlGraphNode.SetIndexInLevel(AValue: integer); begin Level.MoveNode(Self,AValue); end; procedure TLvlGraphNode.SetLevel(AValue: TLvlGraphLevel); begin if AValue=nil then raise Exception.Create('node needs a level'); if AValue.Graph<>Graph then raise Exception.Create('wrong graph'); if FLevel=AValue then Exit; if FLevel<>nil then UnbindLevel; FLevel:=AValue; FLevel.fNodes.Add(Self); end; procedure TLvlGraphNode.SetOverlayIndex(AValue: integer); begin if FOverlayIndex=AValue then Exit; FOverlayIndex:=AValue; Invalidate; end; procedure TLvlGraphNode.SetSelected(AValue: boolean); procedure Unselect; begin if FPrevSelected<>nil then FPrevSelected.FNextSelected:=FNextSelected else Graph.FFirstSelected:=FNextSelected; if FNextSelected<>nil then FNextSelected.FPrevSelected:=FPrevSelected else Graph.FLastSelected:=FPrevSelected; FNextSelected:=nil; FPrevSelected:=nil; end; procedure Select; begin FPrevSelected:=Graph.LastSelected; if FPrevSelected<>nil then FPrevSelected.FNextSelected:=Self else Graph.FFirstSelected:=Self; Graph.FLastSelected:=Self; end; begin if FSelected=AValue then begin if Graph=nil then exit; if not FSelected then exit; if Graph.LastSelected=Self then exit; // make this node the last selected Unselect; Select; SelectionChanged; exit; end; // change Selected FSelected:=AValue; if Graph<>nil then begin if Selected then begin Select; end else begin Unselect; end; end; SelectionChanged; end; procedure TLvlGraphNode.SetVisible(AValue: boolean); begin if FVisible=AValue then Exit; FVisible:=AValue; Invalidate; end; procedure TLvlGraphNode.UnbindLevel; begin if FLevel<>nil then FLevel.fNodes.Remove(Self); end; procedure TLvlGraphNode.SelectionChanged; begin if Graph<>nil then Graph.SelectionChanged; end; procedure TLvlGraphNode.Invalidate; begin if Graph<>nil then Graph.Invalidate; end; constructor TLvlGraphNode.Create(TheGraph: TLvlGraph; TheCaption: string; TheLevel: TLvlGraphLevel); begin FGraph:=TheGraph; FCaption:=TheCaption; FInEdges:=TFPList.Create; FOutEdges:=TFPList.Create; FDrawSize:=1; FVisible:=true; FImageIndex:=-1; FOverlayIndex:=-1; FImageEffect:=DefaultLvlGraphNodeImageEffect; Level:=TheLevel; end; destructor TLvlGraphNode.Destroy; begin Selected:=false; Clear; UnbindLevel; if Graph<>nil then Graph.InternalRemoveNode(Self); FreeAndNil(FInEdges); FreeAndNil(FOutEdges); inherited Destroy; end; procedure TLvlGraphNode.Clear; begin while InEdgeCount>0 do InEdges[InEdgeCount-1].Free; while OutEdgeCount>0 do OutEdges[OutEdgeCount-1].Free; end; function TLvlGraphNode.IndexOfInEdge(Source: TLvlGraphNode): integer; begin for Result:=0 to InEdgeCount-1 do if InEdges[Result].Source=Source then exit; Result:=-1; end; function TLvlGraphNode.FindInEdge(Source: TLvlGraphNode): TLvlGraphEdge; var i: Integer; begin i:=IndexOfInEdge(Source); if i>=0 then Result:=InEdges[i] else Result:=nil; end; function TLvlGraphNode.IndexOfOutEdge(Target: TLvlGraphNode): integer; begin for Result:=0 to OutEdgeCount-1 do if OutEdges[Result].Target=Target then exit; Result:=-1; end; function TLvlGraphNode.FindOutEdge(Target: TLvlGraphNode): TLvlGraphEdge; var i: Integer; begin i:=IndexOfOutEdge(Target); if i>=0 then Result:=OutEdges[i] else Result:=nil; end; function TLvlGraphNode.OutEdgeCount: integer; begin Result:=FOutEdges.Count; end; function TLvlGraphNode.GetVisibleSourceNodes: TLvlGraphNodeArray; // return all visible nodes connected in Source direction begin Result:=NodeAVLTreeToNodeArray(GetVisibleSourceNodesAsAVLTree,true,true); end; function TLvlGraphNode.GetVisibleSourceNodesAsAVLTree: TAvgLvlTree; // return all visible nodes connected in Source direction procedure Search(Node: TLvlGraphNode); var i: Integer; begin if Node=nil then exit; if Node.Visible then begin Result.Add(Node); end else begin for i:=0 to Node.InEdgeCount-1 do Search(Node.InEdges[i].Source); end; end; var i: Integer; begin Result:=TAvgLvlTree.Create; for i:=0 to InEdgeCount-1 do Search(InEdges[i].Source); end; function TLvlGraphNode.GetVisibleTargetNodes: TLvlGraphNodeArray; // return all visible nodes connected in Target direction begin Result:=NodeAVLTreeToNodeArray(GetVisibleTargetNodesAsAVLTree,true,true); end; function TLvlGraphNode.GetVisibleTargetNodesAsAVLTree: TAvgLvlTree; // return all visible nodes connected in Target direction var Visited: TAvgLvlTree; procedure Search(Node: TLvlGraphNode); var i: Integer; begin if Node=nil then exit; if Visited.Find(Node)<>nil then exit; Visited.Add(Node); if Node.Visible then begin Result.Add(Node); end else begin for i:=0 to Node.OutEdgeCount-1 do Search(Node.OutEdges[i].Target); end; end; var i: Integer; begin Result:=TAvgLvlTree.Create; Visited:=TAvgLvlTree.Create; try for i:=0 to OutEdgeCount-1 do Search(OutEdges[i].Target); finally Visited.Free; end; end; function TLvlGraphNode.DrawCenter: integer; begin Result:=DrawPosition+(DrawSize div 2); end; function TLvlGraphNode.DrawPositionEnd: integer; begin Result:=DrawPosition+DrawSize; end; end.