From cf333ab6056454db6718a31c36e6219c4bcd8771 Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 8 Mar 2013 07:50:45 +0000 Subject: [PATCH] cody: lvlgraph: edge highlighting git-svn-id: trunk@40514 - --- components/codetools/ide/codyctrls.pas | 145 +++++++++++++++++++++---- 1 file changed, 122 insertions(+), 23 deletions(-) diff --git a/components/codetools/ide/codyctrls.pas b/components/codetools/ide/codyctrls.pas index 8377ab845a..2c1db6a278 100644 --- a/components/codetools/ide/codyctrls.pas +++ b/components/codetools/ide/codyctrls.pas @@ -461,6 +461,7 @@ type TLvlGraphCtrlOption = ( lgoAutoLayout, // automatic graph layout after graph was changed lgoHighlightNodeUnderMouse, // when mouse over node highlight node and its edges + lgoHighlightEdgeNearMouse, // when mouse near an edge highlight edge and its edges, lgoHighlightNodeUnderMouse takes precedence lgoMouseSelects, lgoHighLevels // put nodes topologically at higher levels ); @@ -483,7 +484,7 @@ type const DefaultLvlGraphCtrlOptions = [lgoAutoLayout, - lgoHighlightNodeUnderMouse,lgoMouseSelects]; + lgoHighlightNodeUnderMouse,lgoHighlightEdgeNearMouse,lgoMouseSelects]; DefaultLvlGraphEdgeSplitMode = lgesMergeHighest; DefaultLvlGraphNodeWith = 10; DefaultLvlGraphNodeCaptionScale = 0.7; @@ -493,6 +494,7 @@ const DefaultLvlGraphNodeGapTop = 1; DefaultLvlGraphNodeGapBottom = 1; DefaultLvlGraphNodeShape = lgnsRectangle; + DefaultLvlGraphEdgeNearMouseDistMax = 5; type TLvlGraphControlFlag = ( @@ -551,6 +553,8 @@ type TCustomLvlGraphControl = class(TCustomControl) private + FEdgeMouseDistMax: integer; + FEdgeNearMouse: TLvlGraphEdge; FEdgeSplitMode: TLvlGraphEdgeSplitMode; FGraph: TLvlGraph; FImageChangeLink: TChangeLink; @@ -569,6 +573,7 @@ type procedure DrawCaptions(const TxtH: integer); procedure DrawEdges(Highlighted: boolean); procedure DrawNodes; + procedure SetEdgeNearMouse(AValue: TLvlGraphEdge); procedure SetImages(AValue: TCustomImageList); procedure SetNodeStyle(AValue: TLvlGraphNodeStyle); procedure SetNodeUnderMouse(AValue: TLvlGraphNode); @@ -604,13 +609,15 @@ type procedure BeginUpdate; procedure EndUpdate; function GetNodeAt(X,Y: integer): TLvlGraphNode; - function GetEdgeAt(X,Y,Radius: integer): TLvlGraphEdge; + function GetEdgeAt(X,Y: integer; out Distance: integer): TLvlGraphEdge; class function GetControlClassDefaultSize: TSize; override; function GetDrawSize: TPoint; public property EdgeSplitMode: TLvlGraphEdgeSplitMode read FEdgeSplitMode write FEdgeSplitMode default DefaultLvlGraphEdgeSplitMode; property NodeStyle: TLvlGraphNodeStyle read FNodeStyle write SetNodeStyle; property NodeUnderMouse: TLvlGraphNode read FNodeUnderMouse write SetNodeUnderMouse; + property EdgeNearMouse: TLvlGraphEdge read FEdgeNearMouse write SetEdgeNearMouse; + property EdgeMouseDistMax: integer read FEdgeMouseDistMax write FEdgeMouseDistMax default DefaultLvlGraphEdgeNearMouseDistMax; property Options: TLvlGraphCtrlOptions read FOptions write SetOptions default DefaultLvlGraphCtrlOptions; property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged; property ScrollTop: integer read FScrollTop write SetScrollTop; @@ -635,6 +642,7 @@ type property DragCursor; property DragKind; property DragMode; + property EdgeMouseDistMax; property EdgeSplitMode; property Enabled; property Font; @@ -679,6 +687,10 @@ function GetCCPaletteRGB(Cnt: integer; Shuffled: boolean): TCodyCtrlPalette; procedure ShuffleCCPalette(Palette: TCodyCtrlPalette); function Darker(const c: TColor): TColor; overload; +function GetManhattanDistancePointLine(X,Y, LineX1, LineY1, LineX2, LineY2: integer): integer; +function GetDistancePointLine(X,Y, LineX1, LineY1, LineX2, LineY2: integer): integer; +function GetDistancePointPoint(X1,Y1,X2,Y2: integer): integer; + // diagram procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer; InnerSize: single; StartAngle16, EndAngle16: integer); overload; @@ -686,16 +698,16 @@ procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2, InnerSize, StartAngle, EndAngle: single); overload; // level graph +procedure LvlGraphMinimizeCrossings(Graph: TLvlGraph); overload; +procedure LvlGraphHighlightNode(Node: TLvlGraphNode; + HighlightedElements: TAvgLvlTree; FollowIn, FollowOut: boolean); function CompareLGNodesByCenterPos(Node1, Node2: Pointer): integer; +// debugging function dbgs(p: TLvlGraphNodeCaptionPosition): string; overload; function dbgs(o: TLvlGraphCtrlOption): string; overload; function dbgs(Options: TLvlGraphCtrlOptions): string; overload; -procedure LvlGraphMinimizeCrossings(Graph: TLvlGraph); overload; -procedure LvlGraphHighlightNode(Node: TLvlGraphNode; HighlightedElements: TAvgLvlTree; - FollowIn, FollowOut: boolean); - implementation type @@ -798,7 +810,8 @@ begin Min(10000,Graph.NodeCount*Graph.NodeCount)); {$ELSE} g.SwitchAndShuffle(100*Graph.NodeCount, - Min(100000,Graph.NodeCount*Graph.NodeCount)); + Min(100000,Graph.NodeCount*Graph.NodeCount) + ){%H-}; {$ENDIF} g.Apply; finally @@ -846,6 +859,76 @@ begin TV.EndUpdate; end; +function GetManhattanDistancePointLine(X, Y, LineX1, LineY1, LineX2, LineY2: integer + ): integer; +// Manhattan distance +var + m: Integer; +begin + Result:=abs(X-LineX1)+abs(Y-LineY1); + Result:=Min(Result,abs(X-LineX2)+abs(Y-LineY2)); + // from left to right + if abs(LineX2-LineX1)LineY2)) then exit; + if (LineY1>LineY2) and ((YLineY1)) then exit; + m:=((LineX2-LineX1)*(Y-LineY1)) div (LineY2-LineY1); + Result:=Min(Result,abs(X-m)); + end else if LineX1<>LineX2 then begin + // horizontal line + if (LineX1LineX2)) then exit; + if (LineX1>LineX2) and ((XLineX1)) then exit; + m:=((LineY2-LineY1)*(X-LineX1)) div (LineX2-LineX1); + Result:=Min(Result,abs(Y-m)); + end; +end; + +function GetDistancePointLine(X, Y, LineX1, LineY1, LineX2, LineY2: integer + ): integer; +var + lx, ly: single; // nearest point on line + lm, ln, pm, pn: single; + d: integer; +begin + //debugln(['GetDistancePointLine X=',X,',Y=',Y,' Line=',LineX1,',',LineY1,'..',LineX2,',',LineY2]); + Result:=GetDistancePointPoint(X,Y,LineX1,LineY1); + if Result<=1 then exit; + Result:=Min(Result,GetDistancePointPoint(X,Y,LineX2,LineY2)); + if Result<=1 then exit; + if Abs(LineX1-LineX2)<=1 then begin + // vertical line + lx:=LineX1; + ly:=Y; + end else if Abs(LineY1-LineY2)<=1 then begin + lx:=X; + ly:=LineY1; + end else begin + lm:=single(LineY2-LineY1)/single(LineX2-LineX1); + ln:=single(LineY1)-single(LineX1)*lm; + pm:=single(-1)/lm; + pn:=single(Y)-single(X)*pm; + //debugln(['GetDistancePointLine lm=',lm,' ln=',ln,' pm=',pm,' pn=',pn]); + // ly = lx*lm+ln = lx*pm'+pn + // <=> lx*(lm-pm)=pn-ln + // <=> lx = (pn-ln) / (lm-pm) + lx:=(pn-ln)/(lm-pm); + ly:=single(lx)*lm+ln; + end; + //debugln(['GetDistancePointLine lx=',lx,', ly=',ly]); + + // check if nearest point is on the line + if (LineX1LineX2)) then exit; + if (LineX1>LineX2) and ((lx>LineX1) or (lx