mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-06 21:06:39 +02:00
cody: lvlgraph.clear
git-svn-id: trunk@40345 -
This commit is contained in:
parent
d2b6e81288
commit
decc5791e4
@ -515,12 +515,14 @@ type
|
|||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure EraseBackground({%H-}DC: HDC); override;
|
procedure EraseBackground({%H-}DC: HDC); override;
|
||||||
property Graph: TLvlGraph read FGraph;
|
property Graph: TLvlGraph read FGraph;
|
||||||
|
procedure Clear;
|
||||||
procedure AutoLayout(RndColors: boolean = true); virtual;
|
procedure AutoLayout(RndColors: boolean = true); virtual;
|
||||||
procedure Invalidate; override;
|
procedure Invalidate; override;
|
||||||
procedure InvalidateAutoLayout;
|
procedure InvalidateAutoLayout;
|
||||||
procedure BeginUpdate;
|
procedure BeginUpdate;
|
||||||
procedure EndUpdate;
|
procedure EndUpdate;
|
||||||
function GetNodeAt(X,Y: integer): TLvlGraphNode;
|
function GetNodeAt(X,Y: integer): TLvlGraphNode;
|
||||||
|
class function GetControlClassDefaultSize: TSize; override;
|
||||||
public
|
public
|
||||||
property NodeStyle: TLvlGraphNodeStyle read FNodeStyle write SetNodeStyle;
|
property NodeStyle: TLvlGraphNodeStyle read FNodeStyle write SetNodeStyle;
|
||||||
property NodeUnderMouse: TLvlGraphNode read FNodeUnderMouse write SetNodeUnderMouse;
|
property NodeUnderMouse: TLvlGraphNode read FNodeUnderMouse write SetNodeUnderMouse;
|
||||||
@ -1232,6 +1234,16 @@ begin
|
|||||||
// Paint paints all, no need to erase background
|
// Paint paints all, no need to erase background
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCustomLvlGraphControl.Clear;
|
||||||
|
begin
|
||||||
|
BeginUpdate;
|
||||||
|
try
|
||||||
|
Graph.Clear;
|
||||||
|
finally
|
||||||
|
EndUpdate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCustomLvlGraphControl.AutoLayout(RndColors: boolean);
|
procedure TCustomLvlGraphControl.AutoLayout(RndColors: boolean);
|
||||||
{ Min/MaxPixelPerWeight: used to scale Node.DrawSize depending on weight of
|
{ Min/MaxPixelPerWeight: used to scale Node.DrawSize depending on weight of
|
||||||
incoming and outgoing edges
|
incoming and outgoing edges
|
||||||
@ -1343,6 +1355,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
class function TCustomLvlGraphControl.GetControlClassDefaultSize: TSize;
|
||||||
|
begin
|
||||||
|
Result.cx:=200;
|
||||||
|
Result.cy:=200;
|
||||||
|
end;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
{ TGraphLevelerNode - used by TLvlGraph.UpdateLevels }
|
{ TGraphLevelerNode - used by TLvlGraph.UpdateLevels }
|
||||||
|
@ -51,9 +51,9 @@ object UnitDependenciesDialog: TUnitDependenciesDialog
|
|||||||
Height = 416
|
Height = 416
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 669
|
Width = 669
|
||||||
ActivePage = UnitsTabSheet
|
ActivePage = GroupsTabSheet
|
||||||
Align = alClient
|
Align = alClient
|
||||||
TabIndex = 0
|
TabIndex = 1
|
||||||
TabOrder = 2
|
TabOrder = 2
|
||||||
object UnitsTabSheet: TTabSheet
|
object UnitsTabSheet: TTabSheet
|
||||||
Caption = 'UnitsTabSheet'
|
Caption = 'UnitsTabSheet'
|
||||||
@ -112,6 +112,17 @@ object UnitDependenciesDialog: TUnitDependenciesDialog
|
|||||||
end
|
end
|
||||||
object GroupsTabSheet: TTabSheet
|
object GroupsTabSheet: TTabSheet
|
||||||
Caption = 'GroupsTabSheet'
|
Caption = 'GroupsTabSheet'
|
||||||
|
ClientHeight = 387
|
||||||
|
ClientWidth = 665
|
||||||
|
object GroupsSplitter: TSplitter
|
||||||
|
Cursor = crVSplit
|
||||||
|
Left = 0
|
||||||
|
Height = 5
|
||||||
|
Top = 0
|
||||||
|
Width = 665
|
||||||
|
Align = alTop
|
||||||
|
ResizeAnchor = akTop
|
||||||
|
end
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
object Timer1: TTimer
|
object Timer1: TTimer
|
||||||
|
@ -30,13 +30,11 @@ unit CodyUnitDepWnd;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, typinfo, AVL_Tree, FPCanvas,
|
Classes, SysUtils, typinfo, AVL_Tree, FPCanvas, FileUtil, lazutf8classes,
|
||||||
FileUtil, lazutf8classes, LazLogger,
|
LazLogger, TreeFilterEdit, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||||
TreeFilterEdit, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons,
|
Buttons, ComCtrls, LCLType, LazIDEIntf, ProjectIntf, IDEWindowIntf,
|
||||||
ComCtrls, LCLType,
|
PackageIntf, CTUnitGraph, CodeToolManager, DefineTemplates, CTUnitGroupGraph,
|
||||||
LazIDEIntf, ProjectIntf, IDEWindowIntf, PackageIntf,
|
CodeToolsStructs, CodyCtrls;
|
||||||
CTUnitGraph, CodeToolManager, DefineTemplates, CTUnitGroupGraph,
|
|
||||||
CodyCtrls;
|
|
||||||
|
|
||||||
const // ToDo: make resourcestring
|
const // ToDo: make resourcestring
|
||||||
lisSelectAUnit = 'Select an unit';
|
lisSelectAUnit = 'Select an unit';
|
||||||
@ -65,6 +63,7 @@ type
|
|||||||
MainPageControl: TPageControl;
|
MainPageControl: TPageControl;
|
||||||
ProgressBar1: TProgressBar;
|
ProgressBar1: TProgressBar;
|
||||||
GroupsTabSheet: TTabSheet;
|
GroupsTabSheet: TTabSheet;
|
||||||
|
GroupsSplitter: TSplitter;
|
||||||
UnitsTabSheet: TTabSheet;
|
UnitsTabSheet: TTabSheet;
|
||||||
Timer1: TTimer;
|
Timer1: TTimer;
|
||||||
CurUnitTreeFilterEdit: TTreeFilterEdit;
|
CurUnitTreeFilterEdit: TTreeFilterEdit;
|
||||||
@ -73,13 +72,14 @@ type
|
|||||||
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
|
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
|
||||||
procedure FormCreate(Sender: TObject);
|
procedure FormCreate(Sender: TObject);
|
||||||
procedure FormDestroy(Sender: TObject);
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure GroupsLvlGraphSelectionChanged(Sender: TObject);
|
||||||
procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
|
procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
|
||||||
procedure Timer1Timer(Sender: TObject);
|
procedure Timer1Timer(Sender: TObject);
|
||||||
private
|
private
|
||||||
FCurrentUnit: TUGUnit;
|
FCurrentUnit: TUGUnit;
|
||||||
FIdleConnected: boolean;
|
FIdleConnected: boolean;
|
||||||
FUsesGraph: TUsesGraph;
|
FUsesGraph: TUsesGraph;
|
||||||
FGroups: TUGGroups;
|
FGroups: TUGGroups; // referenced by Nodes.Data of GroupsLvlGraph and UnitsLvlGraph
|
||||||
fCircleCategories: array[TUDDUsesType] of TCircleDiagramCategory;
|
fCircleCategories: array[TUDDUsesType] of TCircleDiagramCategory;
|
||||||
procedure SetCurrentUnit(AValue: TUGUnit);
|
procedure SetCurrentUnit(AValue: TUGUnit);
|
||||||
procedure SetIdleConnected(AValue: boolean);
|
procedure SetIdleConnected(AValue: boolean);
|
||||||
@ -93,12 +93,14 @@ type
|
|||||||
procedure UpdateCurUnitDiagram;
|
procedure UpdateCurUnitDiagram;
|
||||||
procedure UpdateCurUnitTreeView;
|
procedure UpdateCurUnitTreeView;
|
||||||
procedure UpdateGroupsLvlGraph;
|
procedure UpdateGroupsLvlGraph;
|
||||||
|
procedure UpdateUnitsLvlGraph;
|
||||||
function NodeTextToUnit(NodeText: string): TUGUnit;
|
function NodeTextToUnit(NodeText: string): TUGUnit;
|
||||||
function UGUnitToNodeText(UGUnit: TUGUnit): string;
|
function UGUnitToNodeText(UGUnit: TUGUnit): string;
|
||||||
function GetFPCSrcDir: string;
|
function GetFPCSrcDir: string;
|
||||||
public
|
public
|
||||||
CurUnitDiagram: TCircleDiagramControl;
|
CurUnitDiagram: TCircleDiagramControl;
|
||||||
GroupsLvlGraph: TLvlGraphControl;
|
GroupsLvlGraph: TLvlGraphControl; // Nodes.Data are Groups in Groups
|
||||||
|
UnitsLvlGraph: TLvlGraphControl; // Nodes.Data are Units in Groups
|
||||||
property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
|
property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
|
||||||
property UsesGraph: TUsesGraph read FUsesGraph;
|
property UsesGraph: TUsesGraph read FUsesGraph;
|
||||||
property Groups: TUGGroups read FGroups;
|
property Groups: TUGGroups read FGroups;
|
||||||
@ -192,6 +194,19 @@ begin
|
|||||||
begin
|
begin
|
||||||
Name:='GroupsLvlGraph';
|
Name:='GroupsLvlGraph';
|
||||||
Caption:='';
|
Caption:='';
|
||||||
|
Align:=alTop;
|
||||||
|
Height:=200;
|
||||||
|
Parent:=GroupsTabSheet;
|
||||||
|
OnSelectionChanged:=@GroupsLvlGraphSelectionChanged;
|
||||||
|
end;
|
||||||
|
|
||||||
|
GroupsSplitter.Top:=GroupsLvlGraph.Height;
|
||||||
|
|
||||||
|
UnitsLvlGraph:=TLvlGraphControl.Create(Self);
|
||||||
|
with UnitsLvlGraph do
|
||||||
|
begin
|
||||||
|
Name:='UnitsLvlGraph';
|
||||||
|
Caption:='';
|
||||||
Align:=alClient;
|
Align:=alClient;
|
||||||
Parent:=GroupsTabSheet;
|
Parent:=GroupsTabSheet;
|
||||||
end;
|
end;
|
||||||
@ -204,10 +219,18 @@ end;
|
|||||||
procedure TUnitDependenciesDialog.FormDestroy(Sender: TObject);
|
procedure TUnitDependenciesDialog.FormDestroy(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
IdleConnected:=false;
|
IdleConnected:=false;
|
||||||
|
GroupsLvlGraph.Clear;
|
||||||
|
UnitsLvlGraph.Clear;
|
||||||
FreeAndNil(FGroups);
|
FreeAndNil(FGroups);
|
||||||
FreeAndNil(FUsesGraph);
|
FreeAndNil(FUsesGraph);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TUnitDependenciesDialog.GroupsLvlGraphSelectionChanged(Sender: TObject
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
UpdateUnitsLvlGraph;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TUnitDependenciesDialog.OnIdle(Sender: TObject; var Done: Boolean);
|
procedure TUnitDependenciesDialog.OnIdle(Sender: TObject; var Done: Boolean);
|
||||||
var
|
var
|
||||||
Completed: boolean;
|
Completed: boolean;
|
||||||
@ -485,6 +508,7 @@ var
|
|||||||
i: Integer;
|
i: Integer;
|
||||||
RequiredPkg: TIDEPackage;
|
RequiredPkg: TIDEPackage;
|
||||||
GroupObj: TObject;
|
GroupObj: TObject;
|
||||||
|
GraphGroup: TLvlGraphNode;
|
||||||
begin
|
begin
|
||||||
GroupsLvlGraph.BeginUpdate;
|
GroupsLvlGraph.BeginUpdate;
|
||||||
Graph:=GroupsLvlGraph.Graph;
|
Graph:=GroupsLvlGraph.Graph;
|
||||||
@ -492,7 +516,8 @@ begin
|
|||||||
AVLNode:=Groups.Groups.FindLowest;
|
AVLNode:=Groups.Groups.FindLowest;
|
||||||
while AVLNode<>nil do begin
|
while AVLNode<>nil do begin
|
||||||
Group:=TUGGroup(AVLNode.Data);
|
Group:=TUGGroup(AVLNode.Data);
|
||||||
Graph.GetNode(Group.Name,true);
|
GraphGroup:=Graph.GetNode(Group.Name,true);
|
||||||
|
GraphGroup.Data:=Group;
|
||||||
GroupObj:=nil;
|
GroupObj:=nil;
|
||||||
if Group.Name=GroupPrefixProject then begin
|
if Group.Name=GroupPrefixProject then begin
|
||||||
// project
|
// project
|
||||||
@ -519,6 +544,82 @@ begin
|
|||||||
GroupsLvlGraph.EndUpdate;
|
GroupsLvlGraph.EndUpdate;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TUnitDependenciesDialog.UpdateUnitsLvlGraph;
|
||||||
|
|
||||||
|
function UnitToCaption(AnUnit: TUGUnit): string;
|
||||||
|
begin
|
||||||
|
Result:=ExtractFileNameOnly(AnUnit.Filename);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
GraphGroup: TLvlGraphNode;
|
||||||
|
NewUnits: TFilenameToPointerTree;
|
||||||
|
UnitGroup: TUGGroup;
|
||||||
|
AVLNode: TAVLTreeNode;
|
||||||
|
GroupUnit: TUGGroupUnit;
|
||||||
|
i: Integer;
|
||||||
|
HasChanged: Boolean;
|
||||||
|
Graph: TLvlGraph;
|
||||||
|
CurUses: TUGUses;
|
||||||
|
SourceGraphNode: TLvlGraphNode;
|
||||||
|
TargetGraphNode: TLvlGraphNode;
|
||||||
|
begin
|
||||||
|
NewUnits:=TFilenameToPointerTree.Create(false);
|
||||||
|
try
|
||||||
|
// fetch new list of units
|
||||||
|
GraphGroup:=GroupsLvlGraph.Graph.FirstSelected;
|
||||||
|
while GraphGroup<>nil do begin
|
||||||
|
UnitGroup:=FGroups.GetGroup(GraphGroup.Caption,false);
|
||||||
|
if UnitGroup<>nil then begin
|
||||||
|
AVLNode:=UnitGroup.Units.FindLowest;
|
||||||
|
while AVLNode<>nil do begin
|
||||||
|
GroupUnit:=TUGGroupUnit(AVLNode.Data);
|
||||||
|
NewUnits[GroupUnit.Filename]:=GroupUnit;
|
||||||
|
AVLNode:=UnitGroup.Units.FindSuccessor(AVLNode);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
GraphGroup:=GraphGroup.NextSelected;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// check if something changed
|
||||||
|
Graph:=UnitsLvlGraph.Graph;
|
||||||
|
HasChanged:=false;
|
||||||
|
i:=0;
|
||||||
|
AVLNode:=NewUnits.Tree.FindLowest;
|
||||||
|
while AVLNode<>nil do begin
|
||||||
|
GroupUnit:=TUGGroupUnit(NewUnits.GetNodeData(AVLNode)^.Value);
|
||||||
|
if (Graph.NodeCount<=i) or (Graph.Nodes[i].Data<>Pointer(GroupUnit)) then begin
|
||||||
|
HasChanged:=true;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
i+=1;
|
||||||
|
AVLNode:=NewUnits.Tree.FindSuccessor(AVLNode);
|
||||||
|
end;
|
||||||
|
if not HasChanged then exit;
|
||||||
|
|
||||||
|
// units changed -> update level graph of units
|
||||||
|
UnitsLvlGraph.BeginUpdate;
|
||||||
|
Graph.Clear;
|
||||||
|
AVLNode:=NewUnits.Tree.FindLowest;
|
||||||
|
while AVLNode<>nil do begin
|
||||||
|
GroupUnit:=TUGGroupUnit(NewUnits.GetNodeData(AVLNode)^.Value);
|
||||||
|
SourceGraphNode:=Graph.GetNode(UnitToCaption(GroupUnit),true);
|
||||||
|
if GroupUnit.UsesUnits<>nil then begin
|
||||||
|
for i:=0 to GroupUnit.UsesUnits.Count-1 do begin
|
||||||
|
CurUses:=TUGUses(GroupUnit.UsesUnits[i]);
|
||||||
|
TargetGraphNode:=Graph.GetNode(UnitToCaption(CurUses.UsesUnit),true);
|
||||||
|
Graph.GetEdge(SourceGraphNode,TargetGraphNode,true);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
AVLNode:=NewUnits.Tree.FindSuccessor(AVLNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
UnitsLvlGraph.EndUpdate;
|
||||||
|
finally
|
||||||
|
NewUnits.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
function TUnitDependenciesDialog.NodeTextToUnit(NodeText: string): TUGUnit;
|
function TUnitDependenciesDialog.NodeTextToUnit(NodeText: string): TUGUnit;
|
||||||
var
|
var
|
||||||
AVLNode: TAVLTreeNode;
|
AVLNode: TAVLTreeNode;
|
||||||
|
Loading…
Reference in New Issue
Block a user