diff --git a/components/codetools/ide/codyunitdepwnd.pas b/components/codetools/ide/codyunitdepwnd.pas index 408f694db7..dd85a04e68 100644 --- a/components/codetools/ide/codyunitdepwnd.pas +++ b/components/codetools/ide/codyunitdepwnd.pas @@ -5,14 +5,20 @@ unit CodyUnitDepWnd; interface uses - Classes, SysUtils, AVL_Tree, contnrs, FileUtil, lazutf8classes, LazLogger, - TreeFilterEdit, CTUnitGraph, CodeToolManager, DefineTemplates, Forms, - Controls, Graphics, Dialogs, ExtCtrls, Buttons, ComCtrls, LazIDEIntf, - ProjectIntf, IDEWindowIntf; + Classes, SysUtils, types, AVL_Tree, contnrs, FileUtil, lazutf8classes, + LazLogger, TreeFilterEdit, CTUnitGraph, CodeToolManager, DefineTemplates, + Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons, ComCtrls, + LCLType, LazIDEIntf, ProjectIntf, IDEWindowIntf; + +resourcestring + a=''; + rsSelectAUnit = 'Select a unit'; + rsClose = 'Close'; const DefaultCategoryGap = 0.04; DefaultFirstCategory = 0; + DefaultCategoryMinSize = 0.05; type TCustomCircleDiagramControl = class; TCircleDiagramCategory = class; @@ -40,21 +46,28 @@ type TCircleDiagramCategory = class(TPersistent) private FCaption: TCaption; + FColor: TColor; FDiagram: TCustomCircleDiagramControl; FMinSize: single; fItems: TObjectList; // list of TCircleDiagramItem 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; + property MinSize: single read FMinSize write SetMinSize default DefaultCategoryMinSize; function Count: integer; property Items[Index: integer]: TCircleDiagramItem read GetItems; + property Color: TColor read FColor write SetColor; end; TCircleDiagramCtrlFlag = ( @@ -68,6 +81,7 @@ type private FCategoryGap: single; FCenterCaption: TCaption; + FCenterCaptionRect: TRect; FFirstCategory: single; fCategories: TObjectList; // list of TCircleDiagramCategory fUpdateLock: integer; @@ -76,26 +90,98 @@ type procedure SetCategoryGap(AValue: single); procedure SetCenterCaption(AValue: TCaption); procedure SetFirstCategory(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; 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 CategoryGap: single read FCategoryGap write SetCategoryGap default DefaultCategoryGap; // in part of a full circle property FirstCategory: single read FFirstCategory write SetFirstCategory default DefaultFirstCategory; // in part of a full circle starting at top function CategoryCount: integer; property Categories[Index: integer]: TCircleDiagramCategory read GetCategories; + property Color default clWhite; + property CenterCaptionRect: TRect read FCenterCaptionRect; 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, + uddutUsedByInterface, + uddutUsedByImplementation + ); + TUDDUsesTypes = set of TUDDUsesType; + { TUnitDependenciesDialog } TUnitDependenciesDialog = class(TForm) @@ -118,14 +204,17 @@ type FCurrentUnit: TUGUnit; FIdleConnected: boolean; FUsesGraph: TUsesGraph; + fCircleCategories: array[TUDDUsesType] of TCircleDiagramCategory; procedure SetCurrentUnit(AValue: TUGUnit); procedure SetIdleConnected(AValue: boolean); procedure AddStartAndTargetUnits; procedure UpdateAll; + procedure UpdateCurUnitDiagram; procedure UpdateCurUnitTreeView; function NodeTextToUnit(NodeText: string): TUGUnit; function UGUnitToNodeText(UGUnit: TUGUnit): string; public + CurUnitDiagram: TCircleDiagramControl; property IdleConnected: boolean read FIdleConnected write SetIdleConnected; property UsesGraph: TUsesGraph read FUsesGraph; property CurrentUnit: TUGUnit read FCurrentUnit write SetCurrentUnit; @@ -181,18 +270,76 @@ begin 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; +begin + inherited Paint; + if cdcNeedUpdateLayout in fFlags then + UpdateLayout; + + // background + Canvas.Brush.Style:=bsSolid; + Canvas.Brush.Color:=Color; + Canvas.FillRect(ClientRect); + + // center caption + Canvas.TextOut(FCenterCaptionRect.Left,FCenterCaptionRect.Top,CenterCaption); +end; + constructor TCustomCircleDiagramControl.Create(AOwner: TComponent); begin - inherited Create(AOwner); - fCategories:=TObjectList.create(true); + BeginUpdate; + try + inherited Create(AOwner); + fCategories:=TObjectList.create(true); + 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); @@ -210,19 +357,32 @@ begin end; procedure TCustomCircleDiagramControl.UpdateLayout; +var + aSize: TSize; begin - if fUpdateLock>0 then begin + if (fUpdateLock>0) or (not IsVisible) or (not HandleAllocated) then begin Include(fFlags,cdcNeedUpdateLayout); exit; end; Exclude(fFlags,cdcNeedUpdateLayout); + // center caption + aSize:=Canvas.TextExtent(CenterCaption); + FCenterCaptionRect:=Bounds((ClientWidth-aSize.cx) div 2, + (ClientHeight-aSize.cy) div 2,aSize.cx,aSize.cy); +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 @@ -231,6 +391,28 @@ 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; @@ -244,6 +426,13 @@ begin 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]); @@ -261,6 +450,18 @@ begin 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 @@ -270,10 +471,25 @@ 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; @@ -308,6 +524,8 @@ end; destructor TCircleDiagramItem.Destroy; begin + if Category<>nil then + Category.InternalRemoveItem(Self); inherited Destroy; end; @@ -341,8 +559,23 @@ begin ProgressBar1.Style:=pbstMarquee; AddStartAndTargetUnits; + Caption:='Unit Dependencies'; + CloseBitBtn.Caption:=rsClose; + IDEDialogLayoutList.ApplyLayout(Self,600,400); + CurUnitDiagram:=TCircleDiagramControl.Create(Self); + with CurUnitDiagram do begin + Name:='CurUnitDiagram'; + Align:=alClient; + fCircleCategories[uddutInterfaceUses]:=AddCategory('Interface uses'); + fCircleCategories[uddutImplementationUses]:=AddCategory('Implementation uses'); + fCircleCategories[uddutUsedByInterface]:=AddCategory('Used by interfaces'); + fCircleCategories[uddutUsedByImplementation]:=AddCategory('Used by implementations'); + CenterCaption:=rsSelectAUnit; + Parent:=Self; + end; + IdleConnected:=true; end; @@ -385,7 +618,7 @@ procedure TUnitDependenciesDialog.SetCurrentUnit(AValue: TUGUnit); begin if FCurrentUnit=AValue then Exit; FCurrentUnit:=AValue; - + UpdateCurUnitDiagram; end; procedure TUnitDependenciesDialog.AddStartAndTargetUnits; @@ -408,6 +641,56 @@ begin UpdateCurUnitTreeView; end; +procedure TUnitDependenciesDialog.UpdateCurUnitDiagram; + + procedure UpdateCircleCategory(List: TFPList; t: TUDDUsesType); + // List is CurrentUnit.UsesUnits or CurrentUnit.UsedByUnits + var + i: Integer; + CurUses: TUGUses; + Item: TCircleDiagramItem; + CurUnit: TUGUnit; + Cnt: Integer; + s: String; + begin + Cnt:=0; + for i:=0 to List.Count-1 do begin + CurUses:=TUGUses(List[i]); + if CurUses.InImplementation<>(t in [uddutImplementationUses,uddutUsedByImplementation]) + then continue; + if t in [uddutInterfaceUses,uddutImplementationUses] then + CurUnit:=CurUses.Owner + else + CurUnit:=CurUses.UsesUnit; + s:=ExtractFileName(CurUnit.Filename); + if fCircleCategories[t].Count>Cnt then begin + Item:=fCircleCategories[t].Items[Cnt]; + Item.Caption:=s + end else + Item:=fCircleCategories[t].AddItem(s); + inc(Cnt); + end; + while fCircleCategories[t].Count>Cnt do + fCircleCategories[t].Items[Cnt].Free; + end; + +begin + CurUnitDiagram.BeginUpdate; + try + if CurrentUnit<>nil then begin + CurUnitDiagram.CenterCaption:=ExtractFilename(CurrentUnit.Filename); + UpdateCircleCategory(CurrentUnit.UsesUnits,uddutInterfaceUses); + UpdateCircleCategory(CurrentUnit.UsesUnits,uddutImplementationUses); + UpdateCircleCategory(CurrentUnit.UsedByUnits,uddutUsedByInterface); + UpdateCircleCategory(CurrentUnit.UsedByUnits,uddutUsedByImplementation); + end else begin + CurUnitDiagram.CenterCaption:=rsSelectAUnit; + end; + finally + CurUnitDiagram.EndUpdate; + end; +end; + procedure TUnitDependenciesDialog.UpdateCurUnitTreeView; var AVLNode: TAVLTreeNode;