Partie III : Créer un composant graphique

unit CircChart;

interface

uses
  Windows, Messages, Forms, Classes, SysUtils, Graphics, Controls, Math,
  ActnList;

type
  TChartQuarter = class;
  TCircleChart = class;

  TChartQuarterActionLink = class(TActionLink)
  protected
    FClient : TChartQuarter;
    procedure AssignClient(AClient : TObject); override;

    function IsAutoCheckLinked : boolean; virtual;
    function IsCaptionLinked : boolean; override;
    function IsPercentLinked : boolean; virtual;
    function IsCheckedLinked : boolean; override;
    function IsEnabledLinked : boolean; override;
    function IsHelpContextLinked : boolean; override;
    function IsHintLinked: boolean; override;
    function IsGroupIndexLinked : boolean; override;
    function IsImageIndexLinked : boolean; override;
    function IsShortCutLinked : boolean; override;
    function IsVisibleLinked : boolean; override;
    function IsShowTextLinked : boolean; virtual;
    function IsOnExecuteLinked : boolean; override;

    procedure SetAutoCheck(Value : boolean); override;
    procedure SetCaption(const value : string); override;
    procedure SetPercent(Value : Single); virtual;
    procedure SetChecked(Value : boolean); override;
    procedure SetEnabled(Value : boolean); override;
    procedure SetHint(const Value : string); override;
    procedure SetShowText(Value : boolean); virtual;
    procedure SetOnExecute(Value : TNotifyEvent); override;
  end;

  TChartQuarterActionLinkClass = class of TChartQuarterActionLink;

  TCustomChartQuarterAction = class(TCustomAction)
  private
    FPercent : Single;
    FShowText : boolean;
    procedure SetPercent(New : Single);
    procedure SetShowText(New : boolean);
  protected
    procedure AssignTo(Dest : TPersistent); override;
  public
    constructor Create(AOwner : TComponent); override;

    property Percent : Single read FPercent write SetPercent;
    property ShowText : boolean read FShowText write SetShowText default True;
  end;

  TChartQuarterAction = class(TCustomChartQuarterAction)
  published
    property AutoCheck;
    property Caption;
    property Percent;
    property Checked;
    property Enabled;
    property GroupIndex;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property SecondaryShortCuts;
    property Visible;
    property ShowText;
    property OnExecute;
    property OnHint;
    property OnUpdate;
  end;

  TChartQuarterGraphics = class(TPersistent)
  private
    FBackgroundBrush : TBrush;
    FTextBrush : TBrush;
    FFont : TFont;
    procedure SetBackgroundBrush(New : TBrush);
    procedure SetTextBrush(New : TBrush);
    procedure SetFont(New : TFont);
  public
    constructor Create(AOnChange : TNotifyEvent = nil);
    destructor Destroy; override;
    procedure Assign(Source : TPersistent); override;
  published
    property BackgroundBrush : TBrush read FBackgroundBrush write SetBackgroundBrush;
    property TextBrush : TBrush read FTextBrush write SetTextBrush;
    property Font : TFont read FFont write SetFont;
  end;

  TChartQuarter = class(TCollectionItem)
  private
    FCircleChart : TCircleChart;
    FActionLink : TChartQuarterActionLink;

    FAutoCheck : boolean;
    FText : string;
    FPercent : Single;
    FDown : boolean;
    FEnabled : boolean;
    FGroupIndex : integer;
    FHint : string;
    FShowText : boolean;
    FGraphics : TChartQuarterGraphics;
    FDownGraphics : TChartQuarterGraphics;
    FDisabledGraphics : TChartQuarterGraphics;

    FOnClick : TNotifyEvent;

    function GetAction : TBasicAction;
    procedure SetAction(New : TBasicAction);
    procedure SetText(const New : string);
    procedure SetPercent(New : Single);
    procedure SetDown(New : boolean);
    procedure SetEnabled(New : boolean);
    procedure SetGroupIndex(New : integer);
    procedure SetGraphics(New : TChartQuarterGraphics);
    procedure SetDownGraphics(New : TChartQuarterGraphics);
    procedure SetDisabledGraphics(New : TChartQuarterGraphics);
    procedure SetShowText(New : boolean);
    procedure GraphicsChange(Sender : TObject);

    procedure DoActionChange(Sender : TObject);

    function IsAutoCheckStored : boolean;
    function IsTextStored : boolean;
    function IsPercentStored : boolean;
    function IsDownStored : boolean;
    function IsEnabledStored : boolean;
    function IsGroupIndexStored : boolean;
    function IsHintStored : boolean;
    function IsShowTextStored : boolean;
  protected
    function GetDisplayName : string; override;
    procedure ActionChange(Sender : TObject; CheckDefaults : boolean); dynamic;
    function GetActionLinkClass : TChartQuarterActionLinkClass; dynamic;

    property ActionLink : TChartQuarterActionLink read FActionLink write FActionLink;
  public
    constructor Create(Collection : TCollection); override;
    destructor Destroy; override;

    procedure Assign(Source : TPersistent); override;

    procedure Click;
  published
    property Action : TBasicAction read GetAction write SetAction;
    property AutoCheck : boolean read FAutoCheck write FAutoCheck stored IsAutoCheckStored;
    property Text : string read FText write SetText stored IsTextStored;
    property Percent : Single read FPercent write SetPercent stored IsPercentStored;
    property Down : boolean read FDown write SetDown stored IsDownStored;
    property Enabled : boolean read FEnabled write SetEnabled stored IsEnabledStored;
    property GroupIndex : integer read FGroupIndex write SetGroupIndex stored IsGroupIndexStored;
    property Hint : string read FHint write FHint stored IsHintStored;
    property ShowText : boolean read FShowText write SetShowText stored IsShowTextStored;
    property Graphics : TChartQuarterGraphics read FGraphics write SetGraphics;
    property DownGraphics : TChartQuarterGraphics read FDownGraphics write SetDownGraphics;
    property DisabledGraphics : TChartQuarterGraphics read FDisabledGraphics write SetDisabledGraphics;

    property OnClick : TNotifyEvent read FOnClick write FOnClick;
  end;

  TChartQuarters = class(TCollection)
  private
    FCircleChart : TCircleChart;
    function GetItem(Index : integer) : TChartQuarter;
    procedure SetItem(Index : integer; Value : TChartQuarter);
  protected
    function GetOwner : TPersistent; override;
    procedure Update(Item : TCollectionItem); override;
  public
    constructor Create(ACircleChart : TCircleChart);

    function Add : TChartQuarter;
    function AddItem(Item : TChartQuarter; Index : integer) : TChartQuarter;
    function Insert(Index : integer) : TChartQuarter;

    property Items[index : integer] : TChartQuarter read GetItem write SetItem; default;
  end;

  TQuarterClickEvent = procedure(Sender : TObject; Index : integer; Quarter : TChartQuarter) of object;

  TCircleChart = class(TGraphicControl)
  private
    FClickedQuarter : integer;
    FPopupQuarter : TChartQuarter;

    FSpoke : integer;
    FBrush : TBrush;
    FPen : TPen;
    FQuarters : TChartQuarters;
    FBaseAngle : integer;

    FOnClickQuarter : TQuarterClickEvent;

    procedure SetSpoke(New : integer);
    procedure SetBrush(New : TBrush);
    procedure SetPen(New : TPen);
    procedure SetQuarters(New : TChartQuarters);
    procedure SetBaseAngle(New : integer);
    procedure GraphicsChange(Sender : TObject);

    procedure CMHintShow(var Message : TCMHintShow); message CM_HINTSHOW;
  protected
    procedure Notification(AComponent : TComponent; Operation : TOperation); override;
    procedure AdjustSize; override;
    procedure Paint; override;

    procedure DoContextPopup(MousePos : TPoint; var Handled : boolean); override;
    procedure MouseDown(Button : TMouseButton; Shift : TShiftState;
      X, Y : integer); override;
    procedure MouseUp(Button : TMouseButton; Shift : TShiftState;
      X, Y : integer); override;
    procedure DoClickQuarter(Index : integer; Quarter : TChartQuarter); virtual;

    procedure ClickQuarter(Index : integer);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    function PointToQuarterIndex(Point : TPoint) : integer;
    function PointToQuarter(Point : TPoint) : TChartQuarter;

    property PopupQuarter : TChartQuarter read FPopupQuarter;
  published
    property AutoSize default True;
    property Color default clNone;
    property DragKind;
    property DragCursor;
    property DragMode;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentShowHint;
    property PopupMenu;
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DockOrientation;
    property ShowHint;
    property Visible;

    property Spoke : integer read FSpoke write SetSpoke default 100;
    property Brush : TBrush read FBrush write SetBrush;
    property Pen : TPen read FPen write SetPen;
    property Quarters : TChartQuarters read FQuarters write SetQuarters;
    property BaseAngle : integer read FBaseAngle write SetBaseAngle default 90;

    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;

    property OnClickQuarter : TQuarterClickEvent read FOnClickQuarter write FOnClickQuarter;
  end;

implementation

//////////////////////////////////////
/// Classe TChartQuarterActionLink ///
//////////////////////////////////////

procedure TChartQuarterActionLink.AssignClient(AClient : TObject);
begin
  FClient := AClient as TChartQuarter;
end;

function TChartQuarterActionLink.IsAutoCheckLinked : boolean;
begin
  Result := (Action is TCustomAction) and
    (FClient.AutoCheck = (Action as TCustomAction).AutoCheck);
end;

function TChartQuarterActionLink.IsCaptionLinked : boolean;
begin
  Result := inherited IsCaptionLinked and
    (FClient.Text = (Action as TCustomAction).Caption);
end;

function TChartQuarterActionLink.IsPercentLinked : boolean;
begin
  Result := (Action is TCustomChartQuarterAction) and
    (FClient.Percent = (Action as TCustomChartQuarterAction).Percent);
end;

function TChartQuarterActionLink.IsCheckedLinked : boolean;
begin
  Result := inherited IsCheckedLinked and
    (FClient.Down = (Action as TCustomAction).Checked);
end;

function TChartQuarterActionLink.IsEnabledLinked : boolean;
begin
  Result := inherited IsEnabledLinked and
    (FClient.Enabled = (Action as TCustomAction).Enabled);
end;

function TChartQuarterActionLink.IsHelpContextLinked : boolean;
begin
  Result := False;
end;

function TChartQuarterActionLink.IsHintLinked : boolean;
begin
  Result := inherited IsHintLinked and
    (FClient.Hint = (Action as TCustomAction).Hint);
end;

function TChartQuarterActionLink.IsGroupIndexLinked : boolean;
begin
  Result := inherited IsGroupIndexLinked and
    (FClient.GroupIndex = (Action as TCustomAction).GroupIndex);
end;

function TChartQuarterActionLink.IsImageIndexLinked : boolean;
begin
  Result := False;
end;

function TChartQuarterActionLink.IsShortCutLinked : boolean;
begin
  Result := False;
end;

function TChartQuarterActionLink.IsVisibleLinked : boolean;
begin
  Result := False;
end;

function TChartQuarterActionLink.IsShowTextLinked : boolean;
begin
  Result := (Action is TCustomChartQuarterAction) and
    (FClient.ShowText = (Action as TCustomChartQuarterAction).ShowText);
end;

function TChartQuarterActionLink.IsOnExecuteLinked : boolean;
begin
  Result := inherited IsOnExecuteLinked and
    (@FClient.OnClick = @Action.OnExecute);
end;

procedure TChartQuarterActionLink.SetAutoCheck(Value : boolean);
begin
  if IsAutoCheckLinked then FClient.AutoCheck := Value;
end;

procedure TChartQuarterActionLink.SetCaption(const Value : string);
begin
  if IsCaptionLinked then FClient.Text := Value;
end;

procedure TChartQuarterActionLink.SetPercent(Value : Single);
begin
  if IsPercentLinked then FClient.Percent := Value;
end;

procedure TChartQuarterActionLink.SetChecked(Value : boolean);
begin
  if IsCheckedLinked then FClient.Down := Value;
end;

procedure TChartQuarterActionLink.SetEnabled(Value : boolean);
begin
  if IsEnabledLinked then FClient.Enabled := Value;
end;

procedure TChartQuarterActionLink.SetHint(const Value : string);
begin
  if IsHintLinked then FClient.Hint := Value;
end;

procedure TChartQuarterActionLink.SetShowText(Value : boolean);
begin
  if IsShowTextLinked then FClient.ShowText := Value;
end;

procedure TChartQuarterActionLink.SetOnExecute(Value : TNotifyEvent);
begin
  if IsOnExecuteLinked then FClient.OnClick := Value;
end;

////////////////////////////////////////
/// Classe TCustomChartQuarterAction ///
////////////////////////////////////////

constructor TCustomChartQuarterAction.Create(AOwner : TComponent);
begin
  inherited;
  FPercent := 0.0;
  FShowText := True;
end;

procedure TCustomChartQuarterAction.SetPercent(New : Single);
var I : integer;
    Link : TActionLink;
begin
  if (New <> FPercent) and (New >= 0.0) then
  begin
    for I := 0 to FClients.Count-1 do
    begin
      Link := TObject(FClients.List[I]) as TActionLink;
      if Assigned(Link) and (Link is TChartQuarterActionLink) then
        TChartQuarterActionLink(Link).SetPercent(New);
    end;
    FPercent := New;
    Change;
  end;
end;

procedure TCustomChartQuarterAction.SetShowText(New : boolean);
var I : integer;
    Link : TActionLink;
begin
  if New <> FShowText then
  begin
    for I := 0 to FClients.Count-1 do
    begin
      Link := TObject(FClients.List[I]) as TActionLink;
      if Assigned(Link) and (Link is TChartQuarterActionLink) then
        TChartQuarterActionLink(Link).SetShowText(New);
    end;
    FShowText := New;
    Change;
  end;
end;

procedure TCustomChartQuarterAction.AssignTo(Dest : TPersistent);
begin
  if Dest is TCustomChartQuarterAction then
    with TCustomChartQuarterAction(Dest) do
    begin
      Percent := Self.Percent;
      ShowText := Self.ShowText;
    end;
  inherited;
end;

////////////////////////////////////
/// Classe TChartQuarterGraphics ///
////////////////////////////////////

constructor TChartQuarterGraphics.Create(AOnChange : TNotifyEvent = nil);
begin
  inherited Create;
  FBackgroundBrush := TBrush.Create;
  FBackgroundBrush.OnChange := AOnChange;
  FTextBrush := TBrush.Create;
  FTextBrush.OnChange := AOnChange;
  FFont := TFont.Create;
  FFont.OnChange := AOnChange;
end;

destructor TChartQuarterGraphics.Destroy;
begin
  FFont.Free;
  FTextBrush.Free;
  FBackgroundBrush.Free;
  inherited Destroy;
end;

procedure TChartQuarterGraphics.SetBackgroundBrush(New : TBrush);
begin
  FBackgroundBrush.Assign(New);
end;

procedure TChartQuarterGraphics.SetTextBrush(New : TBrush);
begin
  FTextBrush.Assign(New);
end;

procedure TChartQuarterGraphics.SetFont(New : TFont);
begin
  FFont.Assign(New);
end;

procedure TChartQuarterGraphics.Assign(Source : TPersistent);
begin
  if Source is TChartQuarterGraphics then
  begin
    with TChartQuarterGraphics(Source) do
    begin
      Self.FBackgroundBrush.Assign(FBackgroundBrush);
      Self.FTextBrush.Assign(FTextBrush);
      Self.FFont.Assign(FFont);
    end;
  end else inherited;
end;

////////////////////////////
/// Classe TChartQuarter ///
////////////////////////////

constructor TChartQuarter.Create(Collection : TCollection);
begin
  inherited;
  FCircleChart := TChartQuarters(Collection).FCircleChart;
  FActionLink := nil;
  FText := '';
  FPercent := 0.0;
  FDown := False;
  FEnabled := True;
  FGroupIndex := 0;
  FHint := '';
  FShowText := True;
  FGraphics := TChartQuarterGraphics.Create(GraphicsChange);
  FDownGraphics := TChartQuarterGraphics.Create(GraphicsChange);
  FDisabledGraphics := TChartQuarterGraphics.Create(GraphicsChange);
end;

destructor TChartQuarter.Destroy;
begin
  FDisabledGraphics.Free;
  FDownGraphics.Free;
  FGraphics.Free;
  if Assigned(FActionLink) then
    FActionLink.Free;
  inherited;
end;

function TChartQuarter.GetAction : TBasicAction;
begin
  if Assigned(FActionLink) then
    Result := FActionLink.Action
  else
    Result := nil;
end;

procedure TChartQuarter.SetAction(New : TBasicAction);
begin
  if New = nil then FreeAndNil(FActionLink) else
  begin
    if not Assigned(FActionLink) then
      FActionLink := GetActionLinkClass.Create(Self);
    FActionLink.Action := New;
    FActionLink.OnChange := DoActionChange;
    ActionChange(New, csLoading in New.ComponentState);
    New.FreeNotification(FCircleChart);
  end;
end;

procedure TChartQuarter.SetText(const New : string);
begin
  FText := New;
  Changed(False);
end;

procedure TChartQuarter.SetPercent(New : Single);
begin
  if New < 0.0 then exit;
  FPercent := New;
  Changed(True);
end;

procedure TChartQuarter.SetDown(New : boolean);
var I : integer;
    Quarter : TChartQuarter;
begin
  if New = FDown then exit;
  FDown := New;
  if ((FActionLink = nil) or (not FActionLink.IsCheckedLinked)) and
     (FGroupIndex > 0) and FDown then
    for I := 0 to Collection.Count-1 do
    begin
      Quarter := TChartQuarters(Collection)[I];
      if (Quarter <> Self) and
         (Quarter.FGroupIndex = FGroupIndex) then
        Quarter.Down := False;
    end;
  Changed(False);
end;

procedure TChartQuarter.SetEnabled(New : boolean);
begin
  FEnabled := New;
  Changed(False);
end;

procedure TChartQuarter.SetGroupIndex(New : integer);
begin
  FGroupIndex := New;
end;

procedure TChartQuarter.SetGraphics(New : TChartQuarterGraphics);
begin
  FGraphics.Assign(New);
end;

procedure TChartQuarter.SetDownGraphics(New : TChartQuarterGraphics);
begin
  FDownGraphics.Assign(New);
end;

procedure TChartQuarter.SetDisabledGraphics(New : TChartQuarterGraphics);
begin
  FDisabledGraphics.Assign(New);
end;

procedure TChartQuarter.SetShowText(New : boolean);
begin
  FShowText := New;
  Changed(False);
end;

procedure TChartQuarter.GraphicsChange(Sender : TObject);
begin
  Changed(False);
end;

procedure TChartQuarter.DoActionChange(Sender : TObject);
begin
  if Sender = FActionLink then
    ActionChange(FActionLink.Action, False);
end;

function TChartQuarter.IsAutoCheckStored : boolean;
begin
  Result := (not Assigned(FActionLink) or not FActionLink.IsAutoCheckLinked) and
    FAutoCheck <> False;
end;

function TChartQuarter.IsTextStored : boolean;
begin
  Result := (not Assigned(FActionLink) or not FActionLink.IsCaptionLinked) and
    (FText <> '');
end;

function TChartQuarter.IsPercentStored : boolean;
begin
  Result := (not Assigned(FActionLink) or not FActionLink.IsPercentLinked) and
    (FPercent <> 0.0);
end;

function TChartQuarter.IsDownStored : boolean;
begin
  Result := (not Assigned(FActionLink) or not FActionLink.IsCheckedLinked) and
    (FDown <> False);
end;

function TChartQuarter.IsEnabledStored : boolean;
begin
  Result := (not Assigned(FActionLink) or not FActionLink.IsEnabledLinked) and
    (FEnabled <> True);
end;

function TChartQuarter.IsGroupIndexStored : boolean;
begin
  Result := (not Assigned(FActionLink) or not FActionLink.IsGroupIndexLinked) and
    (FGroupIndex <> 0);
end;

function TChartQuarter.IsHintStored : boolean;
begin
  Result := (not Assigned(FActionLink) or not FActionLink.IsHintLinked) and
    (FHint <> '');
end;

function TChartQuarter.IsShowTextStored : boolean;
begin
  Result := (not Assigned(FActionLink) or not FActionLink.IsShowTextLinked) and
    (FShowText <> True);
end;

function TChartQuarter.GetDisplayName : string;
begin
  if Text <> '' then
    Result := Format('%s (%f%%)', [FText, FPercent])
  else
    Result := Format('%f%%', [FPercent]);
end;

procedure TChartQuarter.ActionChange(Sender : TObject; CheckDefaults : boolean);
begin
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if not CheckDefaults or (Self.AutoCheck = False) then
        Self.AutoCheck := AutoCheck;
      if not CheckDefaults or (Self.Text = '') then
        Self.Text := Caption;
      if not CheckDefaults or (Self.Down = False) then
        Self.Down := Checked;
      if not CheckDefaults or (Self.Enabled = True) then
        Self.Enabled := Enabled;
      if not CheckDefaults or (Self.Hint = '') then
        Self.Hint := Hint;
      if not CheckDefaults or (Self.GroupIndex = 0) then
        Self.GroupIndex := GroupIndex;
      if not CheckDefaults or not Assigned(Self.OnClick) then
        Self.OnClick := OnExecute;
    end;
  if Sender is TCustomChartQuarterAction then
    with TCustomChartQuarterAction(Sender) do
    begin
      if not CheckDefaults or (Self.Percent = 0.0) then
        Self.Percent := Percent;
      if not CheckDefaults or (Self.ShowText = True) then
        Self.ShowText := ShowText;
    end;
end;

function TChartQuarter.GetActionLinkClass : TChartQuarterActionLinkClass;
begin
  Result := TChartQuarterActionLink;
end;

procedure TChartQuarter.Assign(Source : TPersistent);
var ChartQuarterSource : TChartQuarter;
begin
  if Source is TChartQuarter then
  begin
    ChartQuarterSource := TChartQuarter(Source);
    Action := ChartQuarterSource.Action;
    FText := ChartQuarterSource.FText;
    FPercent := ChartQuarterSource.FPercent;
    FDown := ChartQuarterSource.FDown;
    FEnabled := ChartQuarterSource.FEnabled;
    FGroupIndex := ChartQuarterSource.FGroupIndex;
    FHint := ChartQuarterSource.FHint;
    FShowText := ChartQuarterSource.FShowText;
    FGraphics.Assign(ChartQuarterSource.FGraphics);
    FDownGraphics.Assign(ChartQuarterSource.FDownGraphics);
    FDisabledGraphics.Assign(ChartQuarterSource.FDisabledGraphics);
    Changed(True);
  end else inherited;
end;

procedure TChartQuarter.Clic;
begin
  if Enabled then
  begin
    if AutoCheck and ((not Down) or (GroupIndex = 0)) and
       (not Assigned(ActionLink) or not ActionLink.IsAutoCheckLinked) then
      Down := not Down;
    { Appeler OnClick s'il est assigné et différent du OnExecute de l'action
      associée. Si une action est associée, alors invoquer sa méthode Execute,
      sinon, appeler OnClick }
    if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute) then
      FOnClick(Self)
    else if not (csDesigning in FCircleChart.ComponentState) and (FActionLink <> nil) then
      FActionLink.Action.Execute
    else if Assigned(FOnClick) then
      FOnClick(Self);
    FCircleChart.ClickQuarter(Index);
  end;
end;

/////////////////////////////
/// Classe TChartQuarters ///
/////////////////////////////

constructor TChartQuarters.Create(ACircleChart : TCircleChart);
begin
  inherited Create(TChartQuarter);
  FCircleChart := ACircleChart;
end;

function TChartQuarters.GetItem(Index : integer) : TChartQuarter;
begin
  Result := TChartQuarter(inherited GetItem(Index));
end;

procedure TChartQuarters.SetItem(Index : integer; Value : TChartQuarter);
begin
  inherited SetItem(Index, Value);
end;

function TChartQuarters.GetOwner : TPersistent;
begin
  Result := FCircleChart;
end;

procedure TChartQuarters.Update(Item : TCollectionItem);
begin
  FCircleChart.Invalidate;
end;

function TChartQuarters.Add : TChartQuarter;
begin
  Result := TChartQuarter(inherited Add);
end;

function TChartQuarters.AddItem(Item : TChartQuarter; Index : integer) : TChartQuarter;
begin
  if Item = nil then
    Result := Add
  else
    Result := Item;
  if Assigned(Result) then
  begin
    Result.Collection := Self;
    if Index < 0 then
      Index := Count - 1;
    Result.Index := Index;
  end;
end;

function TChartQuarters.Insert(Index : integer) : TChartQuarter;
begin
  Result := AddItem(nil, Index);
end;

///////////////////////////
/// Classe TCircleChart ///
///////////////////////////

constructor TCircleChart.Create(AOwner : TComponent);
begin
  inherited;
  FClickedQuarter := -1;
  FPopupQuarter := nil;
  Color := clNone;
  FSpoke := 100;
  FBrush := TBrush.Create;
  FBrush.OnChange := GraphicsChange;
  FPen := TPen.Create;
  FPen.OnChange := GraphicsChange;
  FQuarters := TChartQuarters.Create(Self);
  FBaseAngle := 90;
  AutoSize := True;
end;

destructor TCircleChart.Destroy;
begin
  FQuarters.Free;
  FPen.Free;
  FBrush.Free;
  inherited;
end;

procedure TCircleChart.SetSpoke(New : integer);
begin
  if New <= 0 then exit;
  FSpoke := New;
  if AutoSize then AdjustSize;
  Invalidate;
end;

procedure TCircleChart.SetBrush(New : TBrush);
begin
  FBrush.Assign(New);
end;

procedure TCircleChart.SetPen(New : TPen);
begin
  FPen.Assign(New);
end;

procedure TCircleChart.SetQuarters(New : TChartQuarters);
begin
  FQuarters.Assign(New);
end;

procedure TCircleChart.SetBaseAngle(New : integer);
begin
  FBaseAngle := New mod 360;
  if FBaseAngle < 0 then inc(FBaseAngle, 360);
  Invalidate;
end;

procedure TCircleChart.GraphicsChange(Sender : TObject);
begin
  Invalidate;
end;

procedure TCircleChart.CMHintShow(var Message : TCMHintShow);
var Quarter : TChartQuarter;
begin
  inherited;
  if Message.Result <> 0 then exit;
  Quarter := PointToQuarter(Message.HintInfo.CursorPos);
  if Assigned(Quarter) and (Quarter.Hint <> '') then
    Message.HintInfo.HintStr := Quarter.Hint;
end;

procedure TCircleChart.Notification(AComponent : TComponent; Operation : TOperation);
var I : integer;
begin
  inherited;
  if Operation = opRemove then for I := 0 to Quarters.Count-1 do
    if AComponent = Quarters[I].Action then
      Quarters[I].Action := nil;
end;

procedure TCircleChart.AdjustSize;
begin
  if not (csLoading in ComponentState) then
  begin
    Width  := Spoke*2;
    Height := Spoke*2;
  end;
end;

procedure TCircleChart.Paint;
var Center : TPoint;  // Centre du cercle
    CircRect : TRect; // Carré circonscrit au cercle
    I : integer;
    Quarter : TChartQuarter;
    Graphics : TChartQuarterGraphics;
    MinAngle, MidAngle, MaxAngle : Single;
    MinPt, MidPt, MaxPt, TextPos : TPoint;
    Text : string;
    DrawTextRect : TRect;
begin
  // Calcul des données concernant le disque
  Center := Point(Width div 2, Height div 2);
  CircRect := Rect(Center.X-Spoke, Center.Y-Spoke, Center.X+Spoke, Center.Y+Spoke);

  with Canvas do
  begin
    // Dessin de la couleur de fond
    if Color <> clNone then
    begin
      Brush.Color := Color;
      Brush.Style := bsSolid;
      Pen.Style := psClear;
      Ellipse(CircRect);
    end;

    // Dessin du disque
    Brush.Assign(Self.Brush);
    Pen.Assign(Self.Pen);
    Ellipse(CircRect);

    // Dessin des différents quartiers
    MaxAngle := FBaseAngle * Pi / 180;
    for I := 0 to Quarters.Count-1 do
    begin
      Quarter := Quarters[I];
      if Quarter.Percent = 0.0 then Continue;
      if not Quarter.Enabled then
        Graphics := Quarter.DisabledGraphics
      else if Quarter.Down then
        Graphics := Quarter.DownGraphics
      else
        Graphics := Quarter.Graphics;

      // Avancement des angles
      MinAngle := MaxAngle;
      MaxAngle := MinAngle + (Quarter.Percent * 2*Pi / 100);
      MidAngle := (MinAngle + MaxAngle) / 2;

      // Calcul des points
      MinPt := Point(Round(Spoke * Cos(MinAngle)) + Center.X, Height - Round(Spoke * Sin(MinAngle)) - Center.Y);
      MidPt := Point(Round(Spoke * Cos(MidAngle)) + Center.X, Height - Round(Spoke * Sin(MidAngle)) - Center.Y);
      MaxPt := Point(Round(Spoke * Cos(MaxAngle)) + Center.X, Height - Round(Spoke * Sin(MaxAngle)) - Center.Y);

      // Dessin du quartier
      Brush.Assign(Graphics.BackgroundBrush);
      with CircRect do
        Pie(Left, Top, Right, Bottom, MinPt.X, MinPt.Y, MaxPt.X, MaxPt.Y);

      // Calcul de la position du texte et affichage du texte
      if Quarter.ShowText then
      begin
        Brush.Assign(Graphics.TextBrush);
        Font.Assign(Graphics.Font);
        TextPos := Point((Center.X+MidPt.X) div 2, (Center.Y+MidPt.Y) div 2);
        if Quarter.Text <> '' then
          Text := Format('%s'#13#10'(%f%%)', [Quarter.Text, Quarter.Percent])
        else
          Text := Format('%f%%', [Quarter.Percent]);
        DrawTextRect := Rect(0, 0, Width, 0);
        DrawText(Handle, PChar(Text), -1, DrawTextRect, DT_CALCRECT or DT_CENTER or DT_NOPREFIX);
        with TextPos, DrawTextRect do
          DrawTextRect := Rect(X - Right div 2, Y - Bottom div 2, X + Right div 2, Y + Bottom div 2);
        DrawText(Handle, PChar(Text), -1, DrawTextRect, DT_CENTER or DT_NOPREFIX);
      end;
    end;
  end;
end;

procedure TCircleChart.DoContextPopup(MousePos : TPoint; var Handled : boolean);
begin
  FPopupQuarter := PointToQuarter(MousePos);
  inherited;
end;

procedure TCircleChart.MouseDown(Button : TMouseButton; Shift : TShiftState;
  X, Y : integer);
begin
  if Button = mbLeft then
  begin
    FClickedQuarter := PointToQuarterIndex(Point(X, Y));
    if (FClickedQuarter <> -1) and (not Quarters[FClickedQuarter].Enabled) then
      FClickedQuarter := -1;
  end;
end;

procedure TCircleChart.MouseUp(Button : TMouseButton; Shift : TShiftState;
  X, Y : integer);
begin
  if (Button = mbLeft) and (FClickedQuarter <> -1) then
  begin
    if PointToQuarterIndex(Point(X, Y)) = FClickedQuarter then
      Quarters[FClickedQuarter].Clic;
    FClickedQuarter := -1;
  end;
end;

procedure TCircleChart.DoClickQuarter(Index : integer; Quarter : TChartQuarter);
begin
  if Assigned(FOnClickQuarter) then
    FOnClickQuarter(Self, Index, Quarter);
end;

procedure TCircleChart.ClickQuarter(Index : integer);
begin
  if Index <> -1 then
    DoClickQuarter(Index, Quarters[Index]);
end;

function TCircleChart.PointToQuarterIndex(Point : TPoint) : integer;
const
  TwoPi = 2*Pi;
var CenterToPoint, PtCos : Single;
    PtAngle, MinAngle, MaxAngle : Single;
    Quarter : TChartQuarter;
begin
  dec(Point.X, Width  div 2);
  dec(Point.Y, Height div 2);
  Point.Y := -Point.Y;

  CenterToPoint := Sqrt(Point.X*Point.X + Point.Y*Point.Y);
  if CenterToPoint > Spoke then
  begin
    Result := -1;
    exit;
  end;

  PtCos := Point.X / CenterToPoint;
  PtAngle := ArcCos(PtCos);
  if Point.Y < 0 then
    PtAngle := -PtAngle;
  PtAngle := PtAngle - FBaseAngle * Pi / 180;
  PtAngle := PtAngle - TwoPi * Floor(PtAngle/TwoPi);

  MaxAngle := 0;
  Result := 0;
  while Result < FQuarters.Count do
  begin
    Quarter := Quarters[Result];

    MinAngle := MaxAngle;
    MaxAngle := MinAngle + (Quarter.Percent * TwoPi / 100);

    if (MinAngle < PtAngle) and (PtAngle < MaxAngle) then exit;

    inc(Result);
  end;
  Result := -1;
end;

function TCircleChart.PointToQuarter(Point : TPoint) : TChartQuarter;
var Index : integer;
begin
  Index := PointToQuarterIndex(Point);
  if Index = -1 then Result := nil else
    Result := FQuarters[Index];
end;

end.