codetools: added unit groups graph

git-svn-id: trunk@40045 -

.gitattributes

@@ -639,6 +639,7 @@ components/codetools/codetoolsstructs.pas svneol=native#text/pascal
 components/codetools/codetree.pas svneol=native#text/pascal
 components/codetools/ctloadlaz.pas svneol=native#text/plain
 components/codetools/ctunitgraph.pas svneol=native#text/plain
+components/codetools/ctunitgroupgraph.pas svneol=native#text/plain
 components/codetools/ctxmlfixfragment.pas svneol=native#text/plain
 components/codetools/customcodetool.pas svneol=native#text/pascal
 components/codetools/definetemplates.pas svneol=native#text/pascal

components/codetools/codetools.lpk

@@ -29,7 +29,7 @@
     <License Value="GPL-2
 "/>
     <Version Major="1" Release="1"/>
-    <Files Count="59">
+    <Files Count="60">
       <Item1>
         <Filename Value="Makefile"/>
         <Type Value="Text"/>
@@ -267,6 +267,10 @@
         <Filename Value="ctloadlaz.pas"/>
         <UnitName Value="ctloadlaz"/>
       </Item59>
+      <Item60>
+        <Filename Value="ctunitgroupgraph.pas"/>
+        <UnitName Value="ctunitgroupgraph"/>
+      </Item60>
     </Files>
     <LazDoc Paths="docs"/>
     <i18n>

components/codetools/codetools.pas

@@ -18,7 +18,8 @@ uses
   PascalReaderTool, PPUCodeTools, PPUGraph, PPUParser, ResourceCodeTool, 
   SourceChanger, SourceLog, StdCodeTools, OtherIdentifierTree, 
   CodeToolsCfgScript, CTXMLFixFragment, CTUnitGraph, ChangeDeclarationTool, 
-  CodeToolsFPCMsgs, UnitDictionary, ctloadlaz, LazarusPackageIntf;
+  CodeToolsFPCMsgs, UnitDictionary, ctloadlaz, CTUnitGroupGraph, 
+  LazarusPackageIntf;
 
 implementation
 

components/codetools/ctunitgraph.pas

@@ -131,8 +131,8 @@ type
     property TargetFilesTree: TAVLTree read FTargetFiles; // tree of TUGUnit sorted for Filename
     property TargetAll: boolean read FTargetAll write FTargetAll;
 
-    property UnitClass: TUGUnitClass read FUnitClass;
+    property UnitClass: TUGUnitClass read FUnitClass write FUnitClass;
-    property UsesClass: TUGUsesClass read FUsesClass;
+    property UsesClass: TUGUsesClass read FUsesClass write FUsesClass;
   end;
 
 function CompareUGUnitFilenames(UGUnit1, UGUnit2: Pointer): integer;

components/codetools/ctunitgroupgraph.pas

@@ -0,0 +1,202 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author: Mattias Gaertner
+
+  Abstract:
+    Functions and classes to build dependency graphs for groups of pascal units.
+}
+unit CTUnitGroupGraph;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, AVL_Tree, CTUnitGraph;
+
+type
+  TUGGroup = class;
+  TUGGroups = class;
+
+  { TUGGroupUnit }
+
+  TUGGroupUnit = class(TUGUnit)
+  public
+    Group: TUGGroup;
+  end;
+
+  TUGGroup = class
+  private
+    FGroups: TUGGroups;
+    FName: string;
+    FUnits: TAVLTree;
+    procedure SetName(AValue: string);
+  public
+    constructor Create(aName: string; TheGroups: TUGGroups);
+    destructor Destroy; override;
+    procedure Clear;
+    procedure AddUnit(anUnit: TUGGroupUnit);
+    procedure RemoveUnit(anUnit: TUGGroupUnit);
+    property Name: string read FName write SetName;
+    property Groups: TUGGroups read FGroups;
+    property Units: TAVLTree read FUnits; // tree of TUGGroupUnit sorted for Filename
+  end;
+
+  { TUGGroups }
+
+  TUGGroups = class
+  private
+    fClearing: boolean;
+    FGroups: TAVLTree;
+  public
+    constructor Create(Graph: TUsesGraph);
+    destructor Destroy; override;
+    procedure Clear;
+    function GetGroup(Name: string; CreateIfNotExists: boolean): TUGGroup;
+    property Groups: TAVLTree read FGroups; // tree of TUGGroup sorted for Name
+  end;
+
+function CompareUGGroupNames(UGGroup1, UGGroup2: Pointer): integer;
+function CompareNameAndUGGroup(NameAnsistring, UGGroup: Pointer): integer;
+
+implementation
+
+function CompareUGGroupNames(UGGroup1, UGGroup2: Pointer): integer;
+var
+  Group1: TUGGroup absolute UGGroup1;
+  Group2: TUGGroup absolute UGGroup2;
+begin
+  Result:=SysUtils.CompareText(Group1.Name,Group2.Name);
+end;
+
+function CompareNameAndUGGroup(NameAnsistring, UGGroup: Pointer): integer;
+var
+  Group: TUGGroup absolute UGGroup;
+  Name: String;
+begin
+  Name:=AnsiString(NameAnsistring);
+  Result:=SysUtils.CompareText(Name,Group.Name);
+end;
+
+{ TUGGroups }
+
+constructor TUGGroups.Create(Graph: TUsesGraph);
+begin
+  FGroups:=TAVLTree.Create(@CompareUGGroupNames);
+  if (not Graph.UnitClass.InheritsFrom(TUGGroup))
+  and ((Graph.FilesTree.Count>0) or (Graph.QueuedFilesTree.Count>0)
+     or (Graph.TargetFilesTree.Count>0))
+  then
+    raise Exception.Create('TUGGroups.Create Create TUGGroups before adding units');
+  Graph.UnitClass:=TUGGroupUnit;
+end;
+
+destructor TUGGroups.Destroy;
+begin
+  Clear;
+  FreeAndNil(FGroups);
+  inherited Destroy;
+end;
+
+procedure TUGGroups.Clear;
+begin
+  fClearing:=true;
+  try
+    FGroups.FreeAndClear;
+  finally
+    fClearing:=false;
+  end;
+end;
+
+function TUGGroups.GetGroup(Name: string; CreateIfNotExists: boolean): TUGGroup;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FGroups.FindKey(Pointer(Name),@CompareNameAndUGGroup);
+  if Node<>nil then begin
+    Result:=TUGGroup(Node.Data);
+  end else if CreateIfNotExists then begin
+    Result:=TUGGroup.Create(Name,Self);
+    FGroups.Add(Result);
+  end else
+   Result:=nil;
+end;
+
+{ TUGGroup }
+
+procedure TUGGroup.SetName(AValue: string);
+begin
+  if FName=AValue then Exit;
+  if Groups.GetGroup(AValue,false)<>nil then
+    raise Exception.Create('TUGGroup.SetName name already exists');
+  Groups.fGroups.Remove(Self);
+  FName:=AValue;
+  Groups.fGroups.Add(Self);
+end;
+
+constructor TUGGroup.Create(aName: string; TheGroups: TUGGroups);
+begin
+  FGroups:=TheGroups;
+  FUnits:=TAVLTree.Create(@CompareUGUnitFilenames);
+end;
+
+destructor TUGGroup.Destroy;
+begin
+  Clear;
+  if not Groups.fClearing then
+    Groups.FGroups.Remove(Self);
+  fGroups:=nil;
+  FreeAndNil(FUnits);
+  inherited Destroy;
+end;
+
+procedure TUGGroup.Clear;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FUnits.FindLowest;
+  while Node<>nil do begin
+    TUGGroupUnit(Node.Data).Group:=nil;
+    Node:=FUnits.FindSuccessor(Node);
+  end;
+  FUnits.Clear;
+end;
+
+procedure TUGGroup.AddUnit(anUnit: TUGGroupUnit);
+begin
+  if anUnit.Group<>nil then begin
+    anUnit.Group.FUnits.Remove(anUnit);
+    anUnit.Group:=nil;
+  end;
+  FUnits.Add(anUnit);
+  anUnit.Group:=Self;
+end;
+
+procedure TUGGroup.RemoveUnit(anUnit: TUGGroupUnit);
+begin
+  if (anUnit.Group<>nil) and (anUnit.Group<>Self) then
+    raise Exception.Create('TUGGroup.RemoveUnit inconsistency');
+  FUnits.Remove(anUnit);
+  anUnit.Group:=nil;
+end;
+
+end.
+

components/codetools/ide/codyctrls.pas

@@ -30,7 +30,8 @@ unit CodyCtrls;
 interface
 
 uses
-  Classes, SysUtils, ComCtrls, Controls;
+  types, math, contnrs, Classes, SysUtils, FPCanvas,
+  LazLogger, ComCtrls, Controls, Graphics, LCLType;
 
 type
 
@@ -41,8 +42,195 @@ type
     procedure FreeNodeData;
   end;
 
+const
+  FullCircle16 = 360*16;
+  DefaultCategoryGapDegree16 = 0.02*FullCircle16;
+  DefaultFirstCategoryDegree16 = 0;
+  DefaultCategoryMinSize = 1.0;
+  DefaultItemSize = 1.0;
+type
+  TCustomCircleDiagramControl = class;
+  TCircleDiagramCategory = class;
+
+  { TCircleDiagramItem }
+
+  TCircleDiagramItem = class(TPersistent)
+  private
+    FCaption: TCaption;
+    FCategory: TCircleDiagramCategory;
+    FEndDegree16: single;
+    FSize: single;
+    FStartDegree16: single;
+    procedure SetCaption(AValue: TCaption);
+    procedure SetSize(AValue: single);
+    procedure UpdateLayout;
+  public
+    constructor Create(TheCategory: TCircleDiagramCategory);
+    destructor Destroy; override;
+    property Category: TCircleDiagramCategory read FCategory;
+    property Caption: TCaption read FCaption write SetCaption;
+    property Size: single read FSize write SetSize default DefaultItemSize; // scaled to fit
+    property StartDegree16: single read FStartDegree16; // 360*16 = one full circle, 0 at 3o'clock
+    property EndDegree16: single read FEndDegree16;     // 360*16 = one full circle, 0 at 3o'clock
+  end;
+
+  { TCircleDiagramCategory }
+
+  TCircleDiagramCategory = class(TPersistent)
+  private
+    FCaption: TCaption;
+    FColor: TColor;
+    FDiagram: TCustomCircleDiagramControl;
+    FEndDegree16: single;
+    FMinSize: single;
+    fItems: TObjectList; // list of TCircleDiagramItem
+    FSize: single;
+    FStartDegree16: single;
+    function GetItems(Index: integer): TCircleDiagramItem;
+    procedure SetCaption(AValue: TCaption);
+    procedure SetColor(AValue: TColor);
+    procedure SetMinSize(AValue: single);
+    procedure UpdateLayout;
+    procedure Invalidate;
+    procedure InternalRemoveItem(Item: TCircleDiagramItem);
+  public
+    constructor Create(TheDiagram: TCustomCircleDiagramControl);
+    destructor Destroy; override;
+    function InsertItem(Index: integer; aCaption: string): TCircleDiagramItem;
+    function AddItem(aCaption: string): TCircleDiagramItem;
+    property Diagram: TCustomCircleDiagramControl read FDiagram;
+    property Caption: TCaption read FCaption write SetCaption;
+    property MinSize: single read FMinSize write SetMinSize default DefaultCategoryMinSize; // scaled to fit
+    function Count: integer;
+    property Items[Index: integer]: TCircleDiagramItem read GetItems; default;
+    property Color: TColor read FColor write SetColor;
+    property Size: single read FSize;
+    property StartDegree16: single read FStartDegree16; // 360*16 = one full circle, 0 at 3o'clock
+    property EndDegree16: single read FEndDegree16;     // 360*16 = one full circle, 0 at 3o'clock
+  end;
+
+  TCircleDiagramCtrlFlag = (
+    cdcNeedUpdateLayout
+    );
+  TCircleDiagramCtrlFlags = set of TCircleDiagramCtrlFlag;
+
+  { TCustomCircleDiagramControl }
+
+  TCustomCircleDiagramControl = class(TCustomControl)
+  private
+    FCategoryGapDegree16: single;
+    FCenter: TPoint;
+    FCenterCaption: TCaption;
+    FCenterCaptionRect: TRect;
+    FFirstCategoryDegree16: single;
+    fCategories: TObjectList; // list of TCircleDiagramCategory
+    FInnerRadius: single;
+    FOuterRadius: single;
+    fUpdateLock: integer;
+    fFlags: TCircleDiagramCtrlFlags;
+    function GetCategories(Index: integer): TCircleDiagramCategory;
+    procedure SetCategoryGapDegree16(AValue: single);
+    procedure SetCenterCaption(AValue: TCaption);
+    procedure SetFirstCategoryDegree16(AValue: single);
+    procedure InternalRemoveCategory(Category: TCircleDiagramCategory);
+  protected
+    //procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL;
+    //procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
+    procedure CreateWnd; override;
+    procedure UpdateScrollBar;
+    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
+
+    //procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:integer); override;
+    //procedure MouseMove(Shift:TShiftState; X,Y:integer);  override;
+    //procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:integer); override;
+
+    //procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    //procedure HandleStandardKeys(var Key: Word; Shift: TShiftState); virtual;
+    //procedure HandleKeyUp(var Key: Word; Shift: TShiftState); virtual;
+
+    procedure Paint; override;
+    procedure DrawCategory(i: integer);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property CenterCaption: TCaption read FCenterCaption write SetCenterCaption;
+    procedure Clear;
+    procedure BeginUpdate; virtual;
+    procedure EndUpdate; virtual;
+    procedure UpdateLayout;
+    procedure EraseBackground({%H-}DC: HDC); override;
+    function InsertCategory(Index: integer; aCaption: TCaption): TCircleDiagramCategory;
+    function AddCategory(aCaption: TCaption): TCircleDiagramCategory;
+    function IndexOfCategory(aCaption: TCaption): integer;
+    function FindCategory(aCaption: TCaption): TCircleDiagramCategory;
+    property CategoryGapDegree16: single read FCategoryGapDegree16 write SetCategoryGapDegree16 default DefaultCategoryGapDegree16; // 360*16 = one full circle, 0 at 3o'clock
+    property FirstCategoryDegree16: single read FFirstCategoryDegree16 write SetFirstCategoryDegree16 default DefaultFirstCategoryDegree16; // 360*16 = one full circle, 0 at 3o'clock
+    function CategoryCount: integer;
+    property Categories[Index: integer]: TCircleDiagramCategory read GetCategories; default;
+    property Color default clWhite;
+    // computed values
+    property CenterCaptionRect: TRect read FCenterCaptionRect;
+    property Center: TPoint read FCenter;
+    property InnerRadius: single read FInnerRadius;
+    property OuterRadius: single read FOuterRadius;
+
+    // debugging
+    procedure WriteDebugReport(Msg: string);
+  end;
+
+  { TCircleDiagramControl }
+
+  TCircleDiagramControl = class(TCustomCircleDiagramControl)
+  published
+    property Align;
+    property Anchors;
+    property BorderSpacing;
+    property BorderStyle;
+    property BorderWidth;
+    property Color;
+    property Constraints;
+    property DragKind;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property ParentColor default False;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property TabOrder;
+    property TabStop default True;
+    property Tag;
+    property Visible;
+    property OnClick;
+    property OnContextPopup;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnShowHint;
+    property OnStartDrag;
+    property OnUTF8KeyPress;
+  end;
+
 procedure FreeTVNodeData(TV: TCustomTreeView);
 
+procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer;
+  InnerSize: single; StartAngle16, EndAngle16: integer); overload;
+procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2,
+  InnerSize, StartAngle, EndAngle: single); overload;
+
 implementation
 
 procedure FreeTVNodeData(TV: TCustomTreeView);
@@ -61,6 +249,53 @@ begin
   TV.EndUpdate;
 end;
 
+procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer;
+  InnerSize: single; StartAngle16, EndAngle16: integer);
+begin
+  RingSector(Canvas,single(x1),single(y1),single(x2),single(y2),InnerSize,
+    single(StartAngle16)/16,single(EndAngle16)/16);
+end;
+
+procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2, InnerSize, StartAngle,
+  EndAngle: single);
+var
+  OuterCnt: integer;
+  centerx, centery: single;
+  i: Integer;
+  Ang: single;
+  OuterRadiusX, OuterRadiusY, InnerRadiusX, InnerRadiusY: single;
+  Points: array of TPoint;
+  j: Integer;
+begin
+  OuterCnt:=Round(SQRT((Abs(x2-x1)+Abs(y2-y1))*Abs(EndAngle-StartAngle)/FullCircle16)+0.5);
+  centerx:=(x1+x2)/2;
+  centery:=(y1+y2)/2;
+  OuterRadiusX:=(x2-x1)/2;
+  OuterRadiusY:=(y2-y1)/2;
+  InnerRadiusX:=OuterRadiusX*InnerSize;
+  InnerRadiusY:=OuterRadiusY*InnerSize;
+  SetLength(Points,OuterCnt*2+2);
+  j:=0;
+  // outer arc
+  for i:=0 to OuterCnt do begin
+    Ang:=StartAngle+((EndAngle-StartAngle)/OuterCnt)*single(i);
+    Ang:=(Ang/FullCircle16)*2*pi;
+    Points[j].x:=round(centerx+cos(Ang)*OuterRadiusX);
+    Points[j].y:=round(centery-sin(Ang)*OuterRadiusY);
+    inc(j);
+  end;
+  // inner arc
+  for i:=OuterCnt downto 0 do begin
+    Ang:=StartAngle+((EndAngle-StartAngle)/OuterCnt)*single(i);
+    Ang:=(Ang/FullCircle16)*2*pi;
+    Points[j].x:=round(centerx+cos(Ang)*InnerRadiusX);
+    Points[j].y:=round(centery-sin(Ang)*InnerRadiusY);
+    inc(j);
+  end;
+  Canvas.Polygon(Points);
+  SetLength(Points,0);
+end;
+
 { TCodyTreeView }
 
 procedure TCodyTreeView.FreeNodeData;
@@ -68,5 +303,403 @@ begin
   FreeTVNodeData(Self);
 end;
 
+{ TCustomCircleDiagramControl }
+
+procedure TCustomCircleDiagramControl.SetCategoryGapDegree16(AValue: single);
+begin
+  if AValue<0 then AValue:=0;
+  if AValue>0.3 then AValue:=0.3;
+  if FCategoryGapDegree16=AValue then Exit;
+  FCategoryGapDegree16:=AValue;
+  UpdateLayout;
+end;
+
+function TCustomCircleDiagramControl.GetCategories(Index: integer
+  ): TCircleDiagramCategory;
+begin
+  Result:=TCircleDiagramCategory(fCategories[Index]);
+end;
+
+procedure TCustomCircleDiagramControl.SetCenterCaption(AValue: TCaption);
+begin
+  if FCenterCaption=AValue then Exit;
+  FCenterCaption:=AValue;
+  UpdateLayout;
+end;
+
+procedure TCustomCircleDiagramControl.SetFirstCategoryDegree16(AValue: single);
+begin
+  if FFirstCategoryDegree16=AValue then Exit;
+  FFirstCategoryDegree16:=AValue;
+  UpdateLayout;
+end;
+
+procedure TCustomCircleDiagramControl.InternalRemoveCategory(
+  Category: TCircleDiagramCategory);
+begin
+  fCategories.Remove(Category);
+  UpdateLayout;
+end;
+
+procedure TCustomCircleDiagramControl.CreateWnd;
+begin
+  inherited CreateWnd;
+  UpdateScrollBar;
+end;
+
+procedure TCustomCircleDiagramControl.UpdateScrollBar;
+begin
+
+end;
+
+procedure TCustomCircleDiagramControl.DoSetBounds(ALeft, ATop, AWidth,
+  AHeight: integer);
+begin
+  inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
+  UpdateScrollBar;
+end;
+
+procedure TCustomCircleDiagramControl.Paint;
+var
+  i: Integer;
+begin
+  inherited Paint;
+  if cdcNeedUpdateLayout in fFlags then
+    UpdateLayout;
+
+  // background
+  Canvas.Brush.Style:=bsSolid;
+  Canvas.Brush.Color:=Color;
+  Canvas.FillRect(ClientRect);
+
+  Canvas.Brush.Color:=clRed;
+
+  // draw categories
+  for i:=0 to CategoryCount-1 do
+    DrawCategory(i);
+
+  // center caption
+  Canvas.Brush.Style:=bsSolid;
+  Canvas.Brush.Color:=clNone;
+  Canvas.TextOut(FCenterCaptionRect.Left,FCenterCaptionRect.Top,CenterCaption);
+end;
+
+procedure TCustomCircleDiagramControl.DrawCategory(i: integer);
+var
+  Cat: TCircleDiagramCategory;
+begin
+  Cat:=Categories[i];
+  Canvas.Brush.Color:=Cat.Color;
+  RingSector(Canvas,Center.X-OuterRadius,Center.Y-OuterRadius,
+    Center.X+OuterRadius,Center.Y+OuterRadius,
+    single(InnerRadius)/single(OuterRadius),
+    Cat.StartDegree16,Cat.EndDegree16);
+end;
+
+constructor TCustomCircleDiagramControl.Create(AOwner: TComponent);
+begin
+  BeginUpdate;
+  try
+    inherited Create(AOwner);
+    fCategories:=TObjectList.create(true);
+    FFirstCategoryDegree16:=DefaultFirstCategoryDegree16;
+    FCategoryGapDegree16:=DefaultCategoryGapDegree16;
+    Color:=clWhite;
+  finally
+    EndUpdate;
+  end;
+end;
+
+destructor TCustomCircleDiagramControl.Destroy;
+begin
+  BeginUpdate; // disable updates
+  FreeAndNil(fCategories);
+  inherited Destroy;
+end;
+
+procedure TCustomCircleDiagramControl.Clear;
+begin
+  BeginUpdate;
+  try
+    while CategoryCount>0 do
+      Categories[0].Free;
+  finally
+    EndUpdate;
+  end;
+end;
+
+procedure TCustomCircleDiagramControl.BeginUpdate;
+begin
+  inc(fUpdateLock);
+end;
+
+procedure TCustomCircleDiagramControl.EndUpdate;
+begin
+  if fUpdateLock=0 then
+    raise Exception.Create('TCustomCircleDiagramControl.EndUpdate');
+  dec(fUpdateLock);
+  if fUpdateLock=0 then begin
+    if cdcNeedUpdateLayout in fFlags then
+      UpdateLayout;
+  end;
+end;
+
+procedure TCustomCircleDiagramControl.UpdateLayout;
+var
+  aSize: TSize;
+  aCategory: TCircleDiagramCategory;
+  i: Integer;
+  j: Integer;
+  TotalSize: Single;
+  CurCategoryDegree: Single;
+  GapDegree: Single;
+  TotalItemDegree: Single;
+  Item: TCircleDiagramItem;
+  CurItemDegree: Single;
+begin
+  if (fUpdateLock>0) or (not IsVisible) or (not HandleAllocated) then begin
+    Include(fFlags,cdcNeedUpdateLayout);
+    exit;
+  end;
+  Exclude(fFlags,cdcNeedUpdateLayout);
+
+  // center caption
+  FCenter:=Point(ClientWidth div 2,ClientHeight div 2);
+  aSize:=Canvas.TextExtent(CenterCaption);
+  FCenterCaptionRect:=Bounds(FCenter.X-(aSize.cx div 2),FCenter.Y-(aSize.cy div 2)
+    ,aSize.cx,aSize.cy);
+
+  // radius
+  fInnerRadius:=0.25*Min(ClientWidth,ClientHeight);
+  fOuterRadius:=1.1*InnerRadius;
+
+  // degrees
+  TotalSize:=0.0;
+  CurCategoryDegree:=FirstCategoryDegree16;
+  if CategoryCount>0 then begin
+    // calculate TotalSize
+    for i:=0 to CategoryCount-1 do begin
+      aCategory:=Categories[i];
+      aCategory.FSize:=0;
+      for j:=0 to aCategory.Count-1 do
+        aCategory.FSize+=aCategory[j].Size;
+      aCategory.FSize:=Max(aCategory.FSize,aCategory.MinSize);
+      TotalSize+=aCategory.FSize;
+    end;
+
+    // calculate degrees
+    GapDegree:=Min(CategoryGapDegree16,(0.8/CategoryCount)*FullCircle16);
+    TotalItemDegree:=FullCircle16-(GapDegree*CategoryCount);
+    for i:=0 to CategoryCount-1 do begin
+      aCategory:=Categories[i];
+      aCategory.FStartDegree16:=CurCategoryDegree;
+      if TotalSize>0 then
+        CurCategoryDegree+=TotalItemDegree*aCategory.Size/TotalSize;
+      aCategory.FEndDegree16:=CurCategoryDegree;
+
+      // item degrees
+      CurItemDegree:=aCategory.StartDegree16;
+      for j:=0 to aCategory.Count-1 do begin
+        Item:=aCategory[j];
+
+        Item.FStartDegree16:=CurItemDegree;
+        if aCategory.Size>0 then
+          CurItemDegree+=(aCategory.EndDegree16-aCategory.StartDegree16)*Item.Size/aCategory.Size;
+        Item.FEndDegree16:=CurItemDegree;
+      end;
+
+      CurCategoryDegree+=GapDegree;
+    end;
+  end;
+
+  WriteDebugReport('TCustomCircleDiagramControl.UpdateLayout');
+end;
+
+procedure TCustomCircleDiagramControl.EraseBackground(DC: HDC);
+begin
+  // do not erase background, Paint will paint the whole area
+end;
+
+function TCustomCircleDiagramControl.InsertCategory(Index: integer;
+  aCaption: TCaption): TCircleDiagramCategory;
+begin
+  Result:=TCircleDiagramCategory.Create(Self);
+  Result.Caption:=aCaption;
+  fCategories.Insert(Index,Result);
+end;
+
+function TCustomCircleDiagramControl.AddCategory(aCaption: TCaption
+  ): TCircleDiagramCategory;
+begin
+  Result:=InsertCategory(CategoryCount,aCaption);
+end;
+
+function TCustomCircleDiagramControl.IndexOfCategory(aCaption: TCaption
+  ): integer;
+begin
+  Result:=CategoryCount-1;
+  while Result>=0 do begin
+    if Categories[Result].Caption=aCaption then exit;
+    dec(Result);
+  end;
+end;
+
+function TCustomCircleDiagramControl.FindCategory(aCaption: TCaption
+  ): TCircleDiagramCategory;
+var
+  i: Integer;
+begin
+  i:=IndexOfCategory(aCaption);
+  if i>=0 then
+    Result:=Categories[i]
+  else
+    Result:=nil;
+end;
+
+function TCustomCircleDiagramControl.CategoryCount: integer;
+begin
+  Result:=fCategories.Count;
+end;
+
+procedure TCustomCircleDiagramControl.WriteDebugReport(Msg: string);
+var
+  aCat: TCircleDiagramCategory;
+  i: Integer;
+  j: Integer;
+  Item: TCircleDiagramItem;
+begin
+  DebugLn([Msg,' CategoryCount=',CategoryCount]);
+  for i:=0 to CategoryCount-1 do begin
+    aCat:=Categories[i];
+    debugln(['  Category: ',i,'/',CategoryCount,' ',aCat.Caption,
+      ' MinSize=',aCat.MinSize,
+      ' Size=',aCat.Size,
+      ' Start=',round(aCat.StartDegree16),' End=',round(aCat.EndDegree16)]);
+    for j:=0 to aCat.Count-1 do begin
+      Item:=aCat.Items[j];
+      debugln(['    Item: ',j,'/',aCat.Count,' ',Item.Caption,
+        ' Size=',Item.Size,
+        ' Start=',round(Item.StartDegree16),
+        ' End=',round(Item.EndDegree16)]);
+    end;
+  end;
+end;
+
+{ TCircleDiagramCategory }
+
+procedure TCircleDiagramCategory.SetCaption(AValue: TCaption);
+begin
+  if FCaption=AValue then Exit;
+  FCaption:=AValue;
+end;
+
+procedure TCircleDiagramCategory.SetColor(AValue: TColor);
+begin
+  if FColor=AValue then Exit;
+  FColor:=AValue;
+  Invalidate;
+end;
+
+function TCircleDiagramCategory.GetItems(Index: integer): TCircleDiagramItem;
+begin
+  Result:=TCircleDiagramItem(fItems[Index]);
+end;
+
+procedure TCircleDiagramCategory.SetMinSize(AValue: single);
+begin
+  if AValue<0 then AValue:=0;
+  if FMinSize=AValue then Exit;
+  FMinSize:=AValue;
+  UpdateLayout;
+end;
+
+procedure TCircleDiagramCategory.UpdateLayout;
+begin
+  if Diagram<>nil then
+    Diagram.UpdateLayout;
+end;
+
+procedure TCircleDiagramCategory.Invalidate;
+begin
+  if Diagram<>nil then
+    Diagram.Invalidate;
+end;
+
+procedure TCircleDiagramCategory.InternalRemoveItem(Item: TCircleDiagramItem);
+begin
+  fItems.Remove(Item);
+  UpdateLayout;
+end;
+
+constructor TCircleDiagramCategory.Create(
+  TheDiagram: TCustomCircleDiagramControl);
+begin
+  FDiagram:=TheDiagram;
+  fItems:=TObjectList.Create(true);
+  FMinSize:=DefaultCategoryMinSize;
+end;
+
+destructor TCircleDiagramCategory.Destroy;
+begin
+  if Diagram<>nil then
+    Diagram.InternalRemoveCategory(Self);
+  FreeAndNil(fItems);
+  inherited Destroy;
+end;
+
+function TCircleDiagramCategory.InsertItem(Index: integer; aCaption: string
+  ): TCircleDiagramItem;
+begin
+  Result:=TCircleDiagramItem.Create(Self);
+  Result.Caption:=aCaption;
+  fItems.Insert(Index,Result);
+end;
+
+function TCircleDiagramCategory.AddItem(aCaption: string): TCircleDiagramItem;
+begin
+  Result:=InsertItem(Count,aCaption);
+end;
+
+function TCircleDiagramCategory.Count: integer;
+begin
+  Result:=fItems.Count;
+end;
+
+{ TCircleDiagramItem }
+
+procedure TCircleDiagramItem.SetCaption(AValue: TCaption);
+begin
+  if FCaption=AValue then Exit;
+  FCaption:=AValue;
+  UpdateLayout;
+end;
+
+procedure TCircleDiagramItem.SetSize(AValue: single);
+begin
+  if AValue<0 then AValue:=0;
+  if FSize=AValue then Exit;
+  FSize:=AValue;
+  UpdateLayout;
+end;
+
+procedure TCircleDiagramItem.UpdateLayout;
+begin
+  if Category<>nil then
+    Category.UpdateLayout;
+end;
+
+constructor TCircleDiagramItem.Create(TheCategory: TCircleDiagramCategory);
+begin
+  FCategory:=TheCategory;
+  FSize:=DefaultItemSize;
+end;
+
+destructor TCircleDiagramItem.Destroy;
+begin
+  if Category<>nil then
+    Category.InternalRemoveItem(Self);
+  inherited Destroy;
+end;
+
 end.
 

components/codetools/ide/codyunitdepwnd.pas

@@ -5,198 +5,18 @@ unit CodyUnitDepWnd;
 interface
 
 uses
-  Classes, SysUtils, types, math, typinfo, AVL_Tree, contnrs, FPCanvas,
+  Classes, SysUtils, typinfo, AVL_Tree, FPCanvas,
-  FileUtil, lazutf8classes, LazLogger, TreeFilterEdit, CTUnitGraph,
+  FileUtil, lazutf8classes, LazLogger,
-  CodeToolManager, DefineTemplates, Forms, Controls, Graphics, Dialogs,
+  TreeFilterEdit, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons,
-  ExtCtrls, Buttons, ComCtrls, LCLType, LazIDEIntf, ProjectIntf, IDEWindowIntf;
+  ComCtrls, LCLType,
+  LazIDEIntf, ProjectIntf, IDEWindowIntf,
+  CTUnitGraph, CodeToolManager, DefineTemplates, CTUnitGroupGraph,
+  CodyCtrls;
 
 resourcestring
-  a='';
   rsSelectAUnit = 'Select an unit';
   rsClose = 'Close';
-
-const
-  FullCircle16 = 360*16;
-  DefaultCategoryGapDegree16 = 0.02*FullCircle16;
-  DefaultFirstCategoryDegree16 = 0;
-  DefaultCategoryMinSize = 1.0;
-  DefaultItemSize = 1.0;
 type
-  TCustomCircleDiagramControl = class;
-  TCircleDiagramCategory = class;
-
-  { TCircleDiagramItem }
-
-  TCircleDiagramItem = class(TPersistent)
-  private
-    FCaption: TCaption;
-    FCategory: TCircleDiagramCategory;
-    FEndDegree16: single;
-    FSize: single;
-    FStartDegree16: single;
-    procedure SetCaption(AValue: TCaption);
-    procedure SetSize(AValue: single);
-    procedure UpdateLayout;
-  public
-    constructor Create(TheCategory: TCircleDiagramCategory);
-    destructor Destroy; override;
-    property Category: TCircleDiagramCategory read FCategory;
-    property Caption: TCaption read FCaption write SetCaption;
-    property Size: single read FSize write SetSize default DefaultItemSize; // scaled to fit
-    property StartDegree16: single read FStartDegree16; // 360*16 = one full circle, 0 at 3o'clock
-    property EndDegree16: single read FEndDegree16;     // 360*16 = one full circle, 0 at 3o'clock
-  end;
-
-  { TCircleDiagramCategory }
-
-  TCircleDiagramCategory = class(TPersistent)
-  private
-    FCaption: TCaption;
-    FColor: TColor;
-    FDiagram: TCustomCircleDiagramControl;
-    FEndDegree16: single;
-    FMinSize: single;
-    fItems: TObjectList; // list of TCircleDiagramItem
-    FSize: single;
-    FStartDegree16: single;
-    function GetItems(Index: integer): TCircleDiagramItem;
-    procedure SetCaption(AValue: TCaption);
-    procedure SetColor(AValue: TColor);
-    procedure SetMinSize(AValue: single);
-    procedure UpdateLayout;
-    procedure Invalidate;
-    procedure InternalRemoveItem(Item: TCircleDiagramItem);
-  public
-    constructor Create(TheDiagram: TCustomCircleDiagramControl);
-    destructor Destroy; override;
-    function InsertItem(Index: integer; aCaption: string): TCircleDiagramItem;
-    function AddItem(aCaption: string): TCircleDiagramItem;
-    property Diagram: TCustomCircleDiagramControl read FDiagram;
-    property Caption: TCaption read FCaption write SetCaption;
-    property MinSize: single read FMinSize write SetMinSize default DefaultCategoryMinSize; // scaled to fit
-    function Count: integer;
-    property Items[Index: integer]: TCircleDiagramItem read GetItems; default;
-    property Color: TColor read FColor write SetColor;
-    property Size: single read FSize;
-    property StartDegree16: single read FStartDegree16; // 360*16 = one full circle, 0 at 3o'clock
-    property EndDegree16: single read FEndDegree16;     // 360*16 = one full circle, 0 at 3o'clock
-  end;
-
-  TCircleDiagramCtrlFlag = (
-    cdcNeedUpdateLayout
-    );
-  TCircleDiagramCtrlFlags = set of TCircleDiagramCtrlFlag;
-
-  { TCustomCircleDiagramControl }
-
-  TCustomCircleDiagramControl = class(TCustomControl)
-  private
-    FCategoryGapDegree16: single;
-    FCenter: TPoint;
-    FCenterCaption: TCaption;
-    FCenterCaptionRect: TRect;
-    FFirstCategoryDegree16: single;
-    fCategories: TObjectList; // list of TCircleDiagramCategory
-    FInnerRadius: single;
-    FOuterRadius: single;
-    fUpdateLock: integer;
-    fFlags: TCircleDiagramCtrlFlags;
-    function GetCategories(Index: integer): TCircleDiagramCategory;
-    procedure SetCategoryGapDegree16(AValue: single);
-    procedure SetCenterCaption(AValue: TCaption);
-    procedure SetFirstCategoryDegree16(AValue: single);
-    procedure InternalRemoveCategory(Category: TCircleDiagramCategory);
-  protected
-    //procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL;
-    //procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
-    procedure CreateWnd; override;
-    procedure UpdateScrollBar;
-    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
-
-    //procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:integer); override;
-    //procedure MouseMove(Shift:TShiftState; X,Y:integer);  override;
-    //procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:integer); override;
-
-    //procedure KeyDown(var Key: Word; Shift: TShiftState); override;
-    //procedure HandleStandardKeys(var Key: Word; Shift: TShiftState); virtual;
-    //procedure HandleKeyUp(var Key: Word; Shift: TShiftState); virtual;
-
-    procedure Paint; override;
-    procedure DrawCategory(i: integer);
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    property CenterCaption: TCaption read FCenterCaption write SetCenterCaption;
-    procedure Clear;
-    procedure BeginUpdate; virtual;
-    procedure EndUpdate; virtual;
-    procedure UpdateLayout;
-    procedure EraseBackground({%H-}DC: HDC); override;
-    function InsertCategory(Index: integer; aCaption: TCaption): TCircleDiagramCategory;
-    function AddCategory(aCaption: TCaption): TCircleDiagramCategory;
-    function IndexOfCategory(aCaption: TCaption): integer;
-    function FindCategory(aCaption: TCaption): TCircleDiagramCategory;
-    property CategoryGapDegree16: single read FCategoryGapDegree16 write SetCategoryGapDegree16 default DefaultCategoryGapDegree16; // 360*16 = one full circle, 0 at 3o'clock
-    property FirstCategoryDegree16: single read FFirstCategoryDegree16 write SetFirstCategoryDegree16 default DefaultFirstCategoryDegree16; // 360*16 = one full circle, 0 at 3o'clock
-    function CategoryCount: integer;
-    property Categories[Index: integer]: TCircleDiagramCategory read GetCategories; default;
-    property Color default clWhite;
-    // computed values
-    property CenterCaptionRect: TRect read FCenterCaptionRect;
-    property Center: TPoint read FCenter;
-    property InnerRadius: single read FInnerRadius;
-    property OuterRadius: single read FOuterRadius;
-
-    // debugging
-    procedure WriteDebugReport(Msg: string);
-  end;
-
-  { TCircleDiagramControl }
-
-  TCircleDiagramControl = class(TCustomCircleDiagramControl)
-  published
-    property Align;
-    property Anchors;
-    property BorderSpacing;
-    property BorderStyle;
-    property BorderWidth;
-    property Color;
-    property Constraints;
-    property DragKind;
-    property DragCursor;
-    property DragMode;
-    property Enabled;
-    property Font;
-    property ParentColor default False;
-    property ParentFont;
-    property ParentShowHint;
-    property PopupMenu;
-    property ShowHint;
-    property TabOrder;
-    property TabStop default True;
-    property Tag;
-    property Visible;
-    property OnClick;
-    property OnContextPopup;
-    property OnDblClick;
-    property OnDragDrop;
-    property OnDragOver;
-    property OnEndDrag;
-    property OnEnter;
-    property OnExit;
-    property OnKeyDown;
-    property OnKeyPress;
-    property OnKeyUp;
-    property OnMouseDown;
-    property OnMouseEnter;
-    property OnMouseLeave;
-    property OnMouseMove;
-    property OnMouseUp;
-    property OnShowHint;
-    property OnStartDrag;
-    property OnUTF8KeyPress;
-  end;
-
   TUDDUsesType = (
     uddutInterfaceUses,
     uddutImplementationUses,
@@ -227,6 +47,7 @@ type
     FCurrentUnit: TUGUnit;
     FIdleConnected: boolean;
     FUsesGraph: TUsesGraph;
+    FGroups: TUGGroups;
     fCircleCategories: array[TUDDUsesType] of TCircleDiagramCategory;
     procedure SetCurrentUnit(AValue: TUGUnit);
     procedure SetIdleConnected(AValue: boolean);
@@ -240,6 +61,7 @@ type
     CurUnitDiagram: TCircleDiagramControl;
     property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
     property UsesGraph: TUsesGraph read FUsesGraph;
+    property Groups: TUGGroups read FGroups;
     property CurrentUnit: TUGUnit read FCurrentUnit write SetCurrentUnit;
   end;
 
@@ -248,10 +70,6 @@ var
 
 procedure ShowUnitDependenciesDialog(Sender: TObject);
 
-procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer;
-  InnerSize: single; StartAngle16, EndAngle16: integer); overload;
-procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2, InnerSize, StartAngle, EndAngle: single); overload;
-
 function dbgs(t: TUDDUsesType): string; overload;
 
 implementation
@@ -268,456 +86,11 @@ begin
   end;
 end;
 
-procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2: integer;
-  InnerSize: single; StartAngle16, EndAngle16: integer);
-begin
-  RingSector(Canvas,single(x1),single(y1),single(x2),single(y2),InnerSize,
-    single(StartAngle16)/16,single(EndAngle16)/16);
-end;
-
-procedure RingSector(Canvas: TFPCustomCanvas; x1, y1, x2, y2, InnerSize, StartAngle,
-  EndAngle: single);
-var
-  OuterCnt: integer;
-  centerx, centery: single;
-  i: Integer;
-  Ang: single;
-  OuterRadiusX, OuterRadiusY, InnerRadiusX, InnerRadiusY: single;
-  Points: array of TPoint;
-  j: Integer;
-begin
-  OuterCnt:=Round(SQRT((Abs(x2-x1)+Abs(y2-y1))*Abs(EndAngle-StartAngle)/FullCircle16)+0.5);
-  centerx:=(x1+x2)/2;
-  centery:=(y1+y2)/2;
-  OuterRadiusX:=(x2-x1)/2;
-  OuterRadiusY:=(y2-y1)/2;
-  InnerRadiusX:=OuterRadiusX*InnerSize;
-  InnerRadiusY:=OuterRadiusY*InnerSize;
-  SetLength(Points,OuterCnt*2+2);
-  j:=0;
-  // outer arc
-  for i:=0 to OuterCnt do begin
-    Ang:=StartAngle+((EndAngle-StartAngle)/OuterCnt)*single(i);
-    Ang:=(Ang/FullCircle16)*2*pi;
-    Points[j].x:=round(centerx+cos(Ang)*OuterRadiusX);
-    Points[j].y:=round(centery-sin(Ang)*OuterRadiusY);
-    inc(j);
-  end;
-  // inner arc
-  for i:=OuterCnt downto 0 do begin
-    Ang:=StartAngle+((EndAngle-StartAngle)/OuterCnt)*single(i);
-    Ang:=(Ang/FullCircle16)*2*pi;
-    Points[j].x:=round(centerx+cos(Ang)*InnerRadiusX);
-    Points[j].y:=round(centery-sin(Ang)*InnerRadiusY);
-    inc(j);
-  end;
-  Canvas.Polygon(Points);
-  SetLength(Points,0);
-end;
-
 function dbgs(t: TUDDUsesType): string;
 begin
   Result:=GetEnumName(typeinfo(TUDDUsesType),ord(t));
 end;
 
-{ TCustomCircleDiagramControl }
-
-procedure TCustomCircleDiagramControl.SetCategoryGapDegree16(AValue: single);
-begin
-  if AValue<0 then AValue:=0;
-  if AValue>0.3 then AValue:=0.3;
-  if FCategoryGapDegree16=AValue then Exit;
-  FCategoryGapDegree16:=AValue;
-  UpdateLayout;
-end;
-
-function TCustomCircleDiagramControl.GetCategories(Index: integer
-  ): TCircleDiagramCategory;
-begin
-  Result:=TCircleDiagramCategory(fCategories[Index]);
-end;
-
-procedure TCustomCircleDiagramControl.SetCenterCaption(AValue: TCaption);
-begin
-  if FCenterCaption=AValue then Exit;
-  FCenterCaption:=AValue;
-  UpdateLayout;
-end;
-
-procedure TCustomCircleDiagramControl.SetFirstCategoryDegree16(AValue: single);
-begin
-  if FFirstCategoryDegree16=AValue then Exit;
-  FFirstCategoryDegree16:=AValue;
-  UpdateLayout;
-end;
-
-procedure TCustomCircleDiagramControl.InternalRemoveCategory(
-  Category: TCircleDiagramCategory);
-begin
-  fCategories.Remove(Category);
-  UpdateLayout;
-end;
-
-procedure TCustomCircleDiagramControl.CreateWnd;
-begin
-  inherited CreateWnd;
-  UpdateScrollBar;
-end;
-
-procedure TCustomCircleDiagramControl.UpdateScrollBar;
-begin
-
-end;
-
-procedure TCustomCircleDiagramControl.DoSetBounds(ALeft, ATop, AWidth,
-  AHeight: integer);
-begin
-  inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
-  UpdateScrollBar;
-end;
-
-procedure TCustomCircleDiagramControl.Paint;
-var
-  i: Integer;
-begin
-  inherited Paint;
-  if cdcNeedUpdateLayout in fFlags then
-    UpdateLayout;
-
-  // background
-  Canvas.Brush.Style:=bsSolid;
-  Canvas.Brush.Color:=Color;
-  Canvas.FillRect(ClientRect);
-
-  Canvas.Brush.Color:=clRed;
-
-  // draw categories
-  for i:=0 to CategoryCount-1 do
-    DrawCategory(i);
-
-  // center caption
-  Canvas.Brush.Style:=bsSolid;
-  Canvas.Brush.Color:=clNone;
-  Canvas.TextOut(FCenterCaptionRect.Left,FCenterCaptionRect.Top,CenterCaption);
-end;
-
-procedure TCustomCircleDiagramControl.DrawCategory(i: integer);
-var
-  Cat: TCircleDiagramCategory;
-begin
-  Cat:=Categories[i];
-  Canvas.Brush.Color:=Cat.Color;
-  RingSector(Canvas,Center.X-OuterRadius,Center.Y-OuterRadius,
-    Center.X+OuterRadius,Center.Y+OuterRadius,
-    single(InnerRadius)/single(OuterRadius),
-    Cat.StartDegree16,Cat.EndDegree16);
-end;
-
-constructor TCustomCircleDiagramControl.Create(AOwner: TComponent);
-begin
-  BeginUpdate;
-  try
-    inherited Create(AOwner);
-    fCategories:=TObjectList.create(true);
-    FFirstCategoryDegree16:=DefaultFirstCategoryDegree16;
-    FCategoryGapDegree16:=DefaultCategoryGapDegree16;
-    Color:=clWhite;
-  finally
-    EndUpdate;
-  end;
-end;
-
-destructor TCustomCircleDiagramControl.Destroy;
-begin
-  BeginUpdate; // disable updates
-  FreeAndNil(fCategories);
-  inherited Destroy;
-end;
-
-procedure TCustomCircleDiagramControl.Clear;
-begin
-  BeginUpdate;
-  try
-    while CategoryCount>0 do
-      Categories[0].Free;
-  finally
-    EndUpdate;
-  end;
-end;
-
-procedure TCustomCircleDiagramControl.BeginUpdate;
-begin
-  inc(fUpdateLock);
-end;
-
-procedure TCustomCircleDiagramControl.EndUpdate;
-begin
-  if fUpdateLock=0 then
-    raise Exception.Create('TCustomCircleDiagramControl.EndUpdate');
-  dec(fUpdateLock);
-  if fUpdateLock=0 then begin
-    if cdcNeedUpdateLayout in fFlags then
-      UpdateLayout;
-  end;
-end;
-
-procedure TCustomCircleDiagramControl.UpdateLayout;
-var
-  aSize: TSize;
-  aCategory: TCircleDiagramCategory;
-  i: Integer;
-  j: Integer;
-  TotalSize: Single;
-  CurCategoryDegree: Single;
-  GapDegree: Single;
-  TotalItemDegree: Single;
-  Item: TCircleDiagramItem;
-  CurItemDegree: Single;
-begin
-  if (fUpdateLock>0) or (not IsVisible) or (not HandleAllocated) then begin
-    Include(fFlags,cdcNeedUpdateLayout);
-    exit;
-  end;
-  Exclude(fFlags,cdcNeedUpdateLayout);
-
-  // center caption
-  FCenter:=Point(ClientWidth div 2,ClientHeight div 2);
-  aSize:=Canvas.TextExtent(CenterCaption);
-  FCenterCaptionRect:=Bounds(FCenter.X-(aSize.cx div 2),FCenter.Y-(aSize.cy div 2)
-    ,aSize.cx,aSize.cy);
-
-  // radius
-  fInnerRadius:=0.25*Min(ClientWidth,ClientHeight);
-  fOuterRadius:=1.1*InnerRadius;
-
-  // degrees
-  TotalSize:=0.0;
-  CurCategoryDegree:=FirstCategoryDegree16;
-  if CategoryCount>0 then begin
-    // calculate TotalSize
-    for i:=0 to CategoryCount-1 do begin
-      aCategory:=Categories[i];
-      aCategory.FSize:=0;
-      for j:=0 to aCategory.Count-1 do
-        aCategory.FSize+=aCategory[j].Size;
-      aCategory.FSize:=Max(aCategory.FSize,aCategory.MinSize);
-      TotalSize+=aCategory.FSize;
-    end;
-
-    // calculate degrees
-    GapDegree:=Min(CategoryGapDegree16,(0.8/CategoryCount)*FullCircle16);
-    TotalItemDegree:=FullCircle16-(GapDegree*CategoryCount);
-    for i:=0 to CategoryCount-1 do begin
-      aCategory:=Categories[i];
-      aCategory.FStartDegree16:=CurCategoryDegree;
-      if TotalSize>0 then
-        CurCategoryDegree+=TotalItemDegree*aCategory.Size/TotalSize;
-      aCategory.FEndDegree16:=CurCategoryDegree;
-
-      // item degrees
-      CurItemDegree:=aCategory.StartDegree16;
-      for j:=0 to aCategory.Count-1 do begin
-        Item:=aCategory[j];
-
-        Item.FStartDegree16:=CurItemDegree;
-        if aCategory.Size>0 then
-          CurItemDegree+=(aCategory.EndDegree16-aCategory.StartDegree16)*Item.Size/aCategory.Size;
-        Item.FEndDegree16:=CurItemDegree;
-      end;
-
-      CurCategoryDegree+=GapDegree;
-    end;
-  end;
-
-  WriteDebugReport('TCustomCircleDiagramControl.UpdateLayout');
-end;
-
-procedure TCustomCircleDiagramControl.EraseBackground(DC: HDC);
-begin
-  // do not erase background, Paint will paint the whole area
-end;
-
-function TCustomCircleDiagramControl.InsertCategory(Index: integer;
-  aCaption: TCaption): TCircleDiagramCategory;
-begin
-  Result:=TCircleDiagramCategory.Create(Self);
-  Result.Caption:=aCaption;
-  fCategories.Insert(Index,Result);
-end;
-
-function TCustomCircleDiagramControl.AddCategory(aCaption: TCaption
-  ): TCircleDiagramCategory;
-begin
-  Result:=InsertCategory(CategoryCount,aCaption);
-end;
-
-function TCustomCircleDiagramControl.IndexOfCategory(aCaption: TCaption
-  ): integer;
-begin
-  Result:=CategoryCount-1;
-  while Result>=0 do begin
-    if Categories[Result].Caption=aCaption then exit;
-    dec(Result);
-  end;
-end;
-
-function TCustomCircleDiagramControl.FindCategory(aCaption: TCaption
-  ): TCircleDiagramCategory;
-var
-  i: Integer;
-begin
-  i:=IndexOfCategory(aCaption);
-  if i>=0 then
-    Result:=Categories[i]
-  else
-    Result:=nil;
-end;
-
-function TCustomCircleDiagramControl.CategoryCount: integer;
-begin
-  Result:=fCategories.Count;
-end;
-
-procedure TCustomCircleDiagramControl.WriteDebugReport(Msg: string);
-var
-  aCat: TCircleDiagramCategory;
-  i: Integer;
-  j: Integer;
-  Item: TCircleDiagramItem;
-begin
-  debugln([Msg,' CategoryCount=',CategoryCount]);
-  for i:=0 to CategoryCount-1 do begin
-    aCat:=Categories[i];
-    debugln(['  Category: ',i,'/',CategoryCount,' ',aCat.Caption,
-      ' MinSize=',aCat.MinSize,
-      ' Size=',aCat.Size,
-      ' Start=',round(aCat.StartDegree16),' End=',round(aCat.EndDegree16)]);
-    for j:=0 to aCat.Count-1 do begin
-      Item:=aCat.Items[j];
-      debugln(['    Item: ',j,'/',aCat.Count,' ',Item.Caption,
-        ' Size=',Item.Size,
-        ' Start=',round(Item.StartDegree16),
-        ' End=',round(Item.EndDegree16)]);
-    end;
-  end;
-end;
-
-{ TCircleDiagramCategory }
-
-procedure TCircleDiagramCategory.SetCaption(AValue: TCaption);
-begin
-  if FCaption=AValue then Exit;
-  FCaption:=AValue;
-end;
-
-procedure TCircleDiagramCategory.SetColor(AValue: TColor);
-begin
-  if FColor=AValue then Exit;
-  FColor:=AValue;
-  Invalidate;
-end;
-
-function TCircleDiagramCategory.GetItems(Index: integer): TCircleDiagramItem;
-begin
-  Result:=TCircleDiagramItem(fItems[Index]);
-end;
-
-procedure TCircleDiagramCategory.SetMinSize(AValue: single);
-begin
-  if AValue<0 then AValue:=0;
-  if FMinSize=AValue then Exit;
-  FMinSize:=AValue;
-  UpdateLayout;
-end;
-
-procedure TCircleDiagramCategory.UpdateLayout;
-begin
-  if Diagram<>nil then
-    Diagram.UpdateLayout;
-end;
-
-procedure TCircleDiagramCategory.Invalidate;
-begin
-  if Diagram<>nil then
-    Diagram.Invalidate;
-end;
-
-procedure TCircleDiagramCategory.InternalRemoveItem(Item: TCircleDiagramItem);
-begin
-  fItems.Remove(Item);
-  UpdateLayout;
-end;
-
-constructor TCircleDiagramCategory.Create(
-  TheDiagram: TCustomCircleDiagramControl);
-begin
-  FDiagram:=TheDiagram;
-  fItems:=TObjectList.Create(true);
-  FMinSize:=DefaultCategoryMinSize;
-end;
-
-destructor TCircleDiagramCategory.Destroy;
-begin
-  if Diagram<>nil then
-    Diagram.InternalRemoveCategory(Self);
-  FreeAndNil(fItems);
-  inherited Destroy;
-end;
-
-function TCircleDiagramCategory.InsertItem(Index: integer; aCaption: string
-  ): TCircleDiagramItem;
-begin
-  Result:=TCircleDiagramItem.Create(Self);
-  Result.Caption:=aCaption;
-  fItems.Insert(Index,Result);
-end;
-
-function TCircleDiagramCategory.AddItem(aCaption: string): TCircleDiagramItem;
-begin
-  Result:=InsertItem(Count,aCaption);
-end;
-
-function TCircleDiagramCategory.Count: integer;
-begin
-  Result:=fItems.Count;
-end;
-
-{ TCircleDiagramItem }
-
-procedure TCircleDiagramItem.SetCaption(AValue: TCaption);
-begin
-  if FCaption=AValue then Exit;
-  FCaption:=AValue;
-  UpdateLayout;
-end;
-
-procedure TCircleDiagramItem.SetSize(AValue: single);
-begin
-  if AValue<0 then AValue:=0;
-  if FSize=AValue then Exit;
-  FSize:=AValue;
-  UpdateLayout;
-end;
-
-procedure TCircleDiagramItem.UpdateLayout;
-begin
-  if Category<>nil then
-    Category.UpdateLayout;
-end;
-
-constructor TCircleDiagramItem.Create(TheCategory: TCircleDiagramCategory);
-begin
-  FCategory:=TheCategory;
-  FSize:=DefaultItemSize;
-end;
-
-destructor TCircleDiagramItem.Destroy;
-begin
-  if Category<>nil then
-    Category.InternalRemoveItem(Self);
-  inherited Destroy;
-end;
-
 { TUnitDependenciesDialog }
 
 procedure TUnitDependenciesDialog.CloseBitBtnClick(Sender: TObject);
@@ -745,6 +118,7 @@ end;
 procedure TUnitDependenciesDialog.FormCreate(Sender: TObject);
 begin
   FUsesGraph:=CodeToolBoss.CreateUsesGraph;
+  FGroups:=TUGGroups.Create(FUsesGraph);
   ProgressBar1.Style:=pbstMarquee;
   AddStartAndTargetUnits;
 
@@ -776,6 +150,7 @@ end;
 procedure TUnitDependenciesDialog.FormDestroy(Sender: TObject);
 begin
   IdleConnected:=false;
+  FreeAndNil(FGroups);
   FreeAndNil(FUsesGraph);
 end;