unit TimeCounters;

interface

uses
	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
	Dialogs, ActnList, StdCtrls, ComCtrls, Contnrs, Clipbrd;

type
	TTimeCounter = class(TObjectList)
	private
		FName: String;
		FParent: TTimeCounter;
		FMeasuresCount: Integer;
		FMeasureInProcess: Integer;
		FTotalSpan,
		FStartTime: TDateTime;
		function GetItem(i: Integer): TTimeCounter;
	protected
		procedure Notify(aPtr: Pointer; anOperation: TListNotification); override;
	public
		constructor Create(const aName: String);
		destructor Destroy; override;
		procedure Start;
		procedure Stop;
		procedure DropMeasures;

		function EnsureCounter(const aName: String): TTimeCounter;

		property MeasuresCount: Integer read FMeasuresCount;
		property TotalSpan: TDateTime read FTotalSpan;

		property Name: String read FName;		
		property Items[i: Integer]: TTimeCounter read GetItem; default;
	end;
	
  TTimeCountersForm = class(TForm)
    CountersListView: TListView;
    ClearButton: TButton;
    ClearAllButton: TButton;
    DeleteButton: TButton;
		DeleteAllButton: TButton;
		CloseButton: TButton;
		Actions: TActionList;
		DeleteCounter: TAction;
		ClearCounter: TAction;
		DeleteAll: TAction;
		ClearAll: TAction;
    CopyToClipBoard: TAction;
    Button1: TButton;
		procedure FormCreate(Sender: TObject);
		procedure ClearAllExecute(Sender: TObject);
		procedure ClearCounterExecute(Sender: TObject);
		procedure DeleteCounterExecute(Sender: TObject);
		procedure DeleteAllExecute(Sender: TObject);
    procedure CopyToClipBoardExecute(Sender: TObject);
	private
		procedure RefreshCounterList;
		{ Private declarations }
	public
		{ Public declarations }
	end;

{ $IFDEF DEBUG}
var
	Counters: TTimeCounter = nil;
	
procedure ShowCounters;
{ $ENDIF}

implementation

{$R *.dfm}

procedure ShowCounters;
begin
	with TTimeCountersForm.Create(Application) do
		try
			ShowModal
		finally
			Free
		end
end;

{ TTimeCounter }

constructor TTimeCounter.Create(const aName: String);
begin
	inherited Create(True);
	FName := aName;
end;

destructor TTimeCounter.Destroy;
begin
	Clear;
	if Assigned(FParent) then begin
		FParent.Extract(Self);
		FParent := nil;
	end;
	inherited;
end;

procedure TTimeCounter.DropMeasures;
var
	i: Integer;
begin
	FMeasuresCount := 0;
	FTotalSpan := 0;
	for i := 0 to Count - 1 do
		Items[i].DropMeasures;
end;

function TTimeCounter.EnsureCounter(const aName: String): TTimeCounter;
var
	i: Integer;
begin
	for i := 0 to Count - 1 do begin
		Result := Items[i];
		if SameText(Result.FName, aName) then
			Exit;
	end;
	Result := TTimeCounter.Create(aName);
	Add(Result);
end;

function TTimeCounter.GetItem(i: Integer): TTimeCounter;
begin
	Result := TTimeCounter(inherited Items[i]);
end;

procedure TTimeCounter.Notify(aPtr: Pointer;
  anOperation: TListNotification);
begin
	case anOperation of
    lnAdded: TTimeCounter(aPtr).FParent := Self;
		lnDeleted: TTimeCounter(aPtr).FParent := nil;
	end;
  inherited;
end;

procedure TTimeCounter.Start;
begin
	if FMeasureInProcess = 0 then
		FStartTime := Now;
	Inc(FMeasureInProcess);
end;

procedure TTimeCounter.Stop;
begin
	Dec(FMeasureInProcess);
	if FMeasureInProcess = 0 then begin
		FTotalSpan := FTotalSpan + Now - FStartTime;
		Inc(FMeasuresCount);
	end;
end;

{ TTimeCountersForm }

procedure TTimeCountersForm.RefreshCounterList;

	procedure AddListItems(aParent: TTimeCounter; aLevel: Integer);
	var
		i: Integer;
		aCounter: TTimeCounter;
		s: String;
		aTotal: TDateTime;
		aListItem: TListItem;
	begin
		for i := 0 to aParent.Count - 1 do begin
			aCounter := aParent[i];
			aListItem := CountersListView.Items.Add;
			aListItem.Caption := StringOfChar(' ', 4*aLevel) + aCounter.FName;
			aListItem.Data := aCounter;
			aListItem.SubItems.Add(IntToStr(aCounter.FMeasuresCount));
			aTotal := aCounter.FTotalSpan;
			DateTimeToString(s, 'hh:nn:ss  z', aTotal);
			aListItem.SubItems.Add(s);
			if aCounter.FMeasuresCount > 0 then
				aTotal := aTotal/aCounter.FMeasuresCount;
			DateTimeToString(s, 'hh:nn:ss  z', aTotal);
			aListItem.SubItems.Add(s);
			if aParent.FTotalSpan <> 0 then
				aListItem.SubItems.Add(Format('%0.2f', [aCounter.FTotalSpan*100/aParent.FTotalSpan]));
			AddListItems(aCounter, aLevel + 1);
		end;
	end;

begin
	CountersListView.Items.Clear;
	CountersListView.Items.BeginUpdate;
	try
		AddListItems(Counters, 0);
	finally
		CountersListView.Items.EndUpdate
	end
end;

procedure TTimeCountersForm.FormCreate(Sender: TObject);
begin
	RefreshCounterList
end;

procedure TTimeCountersForm.ClearAllExecute(Sender: TObject);
begin
	Counters.DropMeasures;
	RefreshCounterList;
end;

procedure TTimeCountersForm.ClearCounterExecute(Sender: TObject);
begin
	if Assigned(CountersListView.Selected) and Assigned(CountersListView.Selected.Data) then begin
		TTimeCounter(CountersListView.Selected.Data).DropMeasures;
		RefreshCounterList
	end;
end;

procedure TTimeCountersForm.DeleteCounterExecute(Sender: TObject);
begin
	if Assigned(CountersListView.Selected) and Assigned(CountersListView.Selected.Data) then begin
		TTimeCounter(CountersListView.Selected.Data).Free;
		RefreshCounterList
	end;
end;

procedure TTimeCountersForm.DeleteAllExecute(Sender: TObject);
begin
	Counters.Clear;
  RefreshCounterList;
end;

procedure TTimeCountersForm.CopyToClipBoardExecute(Sender: TObject);
var
	aList: TStringList;
	aData: String;
	i: Integer;
begin
	if CountersListView.Items.Count = 0 then
		Exit;

	aList := TStringList.Create;
	try
		aList.Delimiter := Chr(9);

		aData := '';
		for i := 0 to CountersListView.Items.Count - 1 do begin
			aList.Clear;

			aList.Add(CountersListView.Items[i].Caption);
			aList.AddStrings(CountersListView.Items[i].SubItems);
			if aData = '' then
				aData := aList.DelimitedText
			else
				aData := aData + ^M^J + aList.DelimitedText;
		end;

		Clipboard.AsText := aData;
	finally
		aList.Free;
	end;
end;

initialization
	Counters := TTimeCounter.Create('');
finalization
	Counters.Free;
end.
