{**********************************************}
{   TTreeMapSeries TreeMap Charts              }
{   Copyright (c) 2009-2020 by Steema Software }
{**********************************************}
unit TeeTreeMapSeries;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  {$IFNDEF FMX}
  Windows,
  {$ENDIF}
  {$ENDIF}
  Classes, SysUtils, Math,

  {$IFDEF D17}
  System.Types,
  {$ENDIF}
  
  {$IFDEF FMX}
  FMX.Types,
  {$ELSE}
  Graphics,
  {$ENDIF}

  {$IFDEF FMX}
  FMXTee.Canvas, FMXTee.Engine, FMXTee.Chart, FMXTee.Tools, FMXTee.Constants,
  FMXTee.Procs, FMXTee.Series.Organizational, FMXTee.Series.Surface
  {$ELSE}
  TeCanvas, TeEngine, Chart, TeeTools, TeeConst, TeeProcs, TeeOrgSeries,
  TeeSurfa
  {$ENDIF};

type
  TTreeMapItem=class(TOrgItem)
  private
    function GetValue: TChartValue;
    procedure SetValue(const Value: TChartValue);
  public
  published
    property Value:TChartValue read GetValue write SetValue;
  end;

  TTreeMapTiling = (  tmSlice, //Slice & Dice
                      tmStrip
                      //TO-DO -> http://hcil.cs.umd.edu/trs/2001-06/2001-06.html
                      //tmSquarified,
                      //tmPivotMiddle,
                      //tmPivotSize,
                      //tmBinaryTree
                      );

  TTreeMapColorStyle=(csByLevel, csByValue);

  TTreeMapSeries=class(TCustomOrgSeries)
  private
    FColorStyle : TTreeMapColorStyle;
    FMapStyle   : TTreeMapTiling;
    FPalette    : TSeriesColorPalette;

    function GetItem(Index: Integer): TTreeMapItem;
    function GetPaletteSteps:Integer;
    procedure SetColorStyle(const Value: TTreeMapColorStyle);
    procedure SetItem(Index: Integer; const Value: TTreeMapItem);
    procedure SetMapStyle(const Value: TTreeMapTiling);
    procedure SetPalette(const Value: TSeriesColorPalette);
    procedure SetPaletteSteps(const Value: Integer);
  protected
    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    procedure DoBeforeDrawChart; override;
    procedure DrawAllValues; override;
    class Function GetEditorClass:String; override;
    function GetValueColor(ValueIndex:Integer):TColor; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    function Add(const AValue: TChartValue; const Text:String;
                 Superior:Integer=-1;
                 AColor: TColor=clTeeColor):Integer; overload;

    procedure Assign(Source:TPersistent); override;
    Function Clicked(x,y:Integer):Integer; override;
    Function IsValidSourceOf(Value:TChartSeries):Boolean; override;

    property Item[Index:Integer]:TTreeMapItem read GetItem write SetItem; default;
    Function NumSampleValues:Integer; override;
  published
    { Published declarations }
    property Format;
    property Items;
    property Spacing;

    property ColorStyle:TTreeMapColorStyle read FColorStyle write SetColorStyle default csByLevel;
    property MapStyle:TTreeMapTiling read FMapStyle write SetMapStyle default tmSlice;
    property Palette:TSeriesColorPalette read FPalette write SetPalette;
    property PaletteSteps:Integer read GetPaletteSteps write SetPaletteSteps default 10;

    property XValues;
    property YValues;

    property Active;
    property ColorSource;
    property Cursor;
    property HorizAxis;
    property Marks;
    property ParentChart;
    property DataSource;
    property PercentFormat;
    property SeriesColor;
    property ShowInLegend;
    property Title;
    property Transparency;
    property ValueFormat;
    property VertAxis;
    property XLabelsSource;

    property Brush;
    property Pen;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnAfterAdd;
    property OnBeforeAdd;
    property OnClearValues;
    property OnClick;
    property OnDblClick;
    property OnGetMarkText;
    property OnMouseEnter;
    property OnMouseLeave;
  end;

implementation

uses
  {$IFDEF FMX}
  FMXTee.ProConstants
  {$ELSE}
  TeeProCo
  {$ENDIF};

{ TTreeMapSeries }
Constructor TTreeMapSeries.Create(AOwner: TComponent);
begin
  inherited;

  FPalette:=TSeriesColorPalette.Create(Self);
  FPalette.PaletteSteps:=10;

  Spacing.Horizontal:=5;
  Spacing.Vertical:=5;

  Format.TextAlignment:=taLeftJustify;
  Format.ShapeStyle:=fosRoundRectangle;
  Format.RoundSize:=6;
end;

Destructor TTreeMapSeries.Destroy;
begin
  FPalette.Free;
  inherited;
end;

function TTreeMapSeries.Add(const AValue: TChartValue; const Text: String;
  Superior: Integer; AColor: TColor): Integer;
begin
  result:=AddXY(Superior,AValue,Text,AColor);
end;

type
  TFormatAccess=class(TTextShape);

procedure TTreeMapSeries.AddSampleValues(NumValues: Integer;
  OnlyMandatory: Boolean);
var superior: Integer;
    myLabel: String;

  function RandomValue:TChartValue;
  var return: Integer;
  begin
    return:=Random(200);
    while((return < 50) or (return > 150)) do return:=Random(200);
    result:=return;
  end;

begin
  if NumValues > 0 then
  begin
    if Count = 0 then
      superior:= -1
    else
      superior:= Random(Count);
    if Count <=26 then
      myLabel:=Chr(65 + Count)
    else
      myLabel:=IntToStr(Count);

    Add(RandomValue, myLabel, superior);
    AddSampleValues(NumValues - 1, OnlyMandatory);
  end;
end;

type
  TPaletteAccess=class(TCustom3DPaletteSeries);

function TTreeMapSeries.GetValueColor(ValueIndex:Integer):TColor;

  function CalcColor:TColor;
  begin
    if ColorEachPoint then
       result:=inherited GetValueColor(ValueIndex)
    else
    if FColorStyle=csByLevel then
       result:=TPaletteAccess(FPalette.Series).GetValueColorValue(Items[ValueIndex].Level)
    else
      result:=TPaletteAccess(FPalette.Series).GetValueColorValue(MandatoryValueList.Value[ValueIndex]);
  end;

begin
  result:=InternalColor(ValueIndex);

  if result=clNone then
  begin
    if TreatNulls=tnIgnore then
       result:=CalcColor
  end
  else
  if result=clTeeColor then
     result:=CalcColor;
end;

procedure TTreeMapSeries.DoBeforeDrawChart;
begin
  if FColorStyle=csByLevel then
     FPalette.InitColors(Color,0,MaxLevels-1)
  else
     FPalette.InitColors(Color,MandatoryValueList.MinValue,MandatoryValueList.MaxValue);

  inherited;
end;

procedure TTreeMapSeries.SetPalette(const Value: TSeriesColorPalette);
begin
  FPalette.Assign(Value);
end;

type
  TItemAccess=class(TTreeMapItem);

procedure TTreeMapSeries.DrawAllValues;
var
  prevRect : Array of TRect;

  procedure DrawChilds(const List:TIntArray; Level:Integer);
  var totalW : Double;

    function GetTreeSize(const List:TIntArray):Double;
    var t : Integer;
    begin
      result:=0;

      for t:=Low(List) to High(List) do
          result:=result + MandatoryValueList.Value[List[t]];
    end;

    procedure CalcNodesSize(const List:TIntArray);

      // Hides rectangles that don't fit in given space
      procedure CheckRectangleSize(var rect {, container}: TRect);
      begin
        if (rect.Bottom - rect.Top) < 0 then rect.Bottom:=rect.Top;
        if (rect.Right - rect.Left) < 0 then rect.Right:=rect.Left;
      end;

    var t,
        tmpSpH,
        tmpSpV,
        sup       : Integer;

        tmpPos,
        tmpW      : TCoordinate;

        tmpPercent: Double;
        horizontal: Boolean;
        tmpRect   : TRect;
        tmpFont   : TTeeFont;
        tmpItem   : TTreeMapItem;
    begin
      tmpPos:=0;
      sup:=TTreeMapItem(Items[List[0]]).Superior;

      if Level = 0 then
         tmpRect:=ParentChart.ChartRect
      else
         tmpRect:=prevRect[sup]; // Get parent node dimensions

      if sup > -1 then
      begin
        tmpFont:=TItemAccess(Items[sup]).ActiveFormat.Font;

        tmpRect.Top:=tmpRect.Top + {$IFDEF FMX}tmpFont.Size{$ELSE}-tmpFont.Height{$ENDIF}
                     + Spacing.Vertical;

        tmpRect.Left:=tmpRect.Left + Spacing.Horizontal;
      end;

      horizontal:=Level mod 2 = 0; //FStyle = tmSlice

      if FMapStyle = tmStrip then
         horizontal:=not horizontal;

      if horizontal then
         tmpW:=tmpRect.Bottom - tmpRect.Top
      else
         tmpW:=tmpRect.Right - tmpRect.Left;

      for t:=Low(List) to High(List) do
      begin
        tmpItem:=TTreeMapItem(Items[List[t]]);

        if totalW > 0 then
           tmpPercent:=tmpItem.Value/totalW
        else
           tmpPercent:=0;

        if Sup > -1 then
        begin
          tmpSpH:=Spacing.Horizontal;
          tmpSpV:=Spacing.Vertical;
        end
        else
        begin
          tmpSpH:=0;
          tmpSpV:=0;
        end;

        With tmpItem.ShapeBounds do
        begin
          if horizontal then
          begin
            Left:=tmpRect.Left + tmpSpH;
            Top:=tmpRect.Top + tmpPos + tmpSpV;
            Right:=tmpRect.Right - tmpSpH;
            Bottom:=Top + Trunc(tmpW * tmpPercent) - 2*tmpSpV;

            CheckRectangleSize(tmpItem.ShapeBounds {, prevRect[sup]} );
            tmpPos:=Bottom - tmpRect.Top;
          end
          else
          begin
            Left:=tmpRect.Left + tmpPos + tmpSpH;
            Top:=tmpRect.Top + tmpSpV;
            Right:=Left + Trunc(tmpW * tmpPercent) - 2*tmpSpH;
            Bottom:=tmpRect.Bottom - tmpSpV;

            CheckRectangleSize(tmpItem.ShapeBounds {, prevRect[sup]} );
            tmpPos:=Right - tmpRect.Left;
          end;
        end;

        prevRect[tmpItem.Index]:=tmpItem.ShapeBounds; //prevRect used for next level.

        if Assigned(tmpItem.FFormat) then
           tmpItem.FFormat.ShapeBounds:=tmpItem.ShapeBounds;
      end;
    end;

  var t : Integer;
      IFormat : TTextShape;
      sup : Integer;
      tmpRoots : TIntArray;
      tmpIndex : Integer;
  begin
    {$IFNDEF D7}
    tmpRoots:=nil;
    {$ENDIF}

    if (FMapStyle=tmSlice) or (FMapStyle=tmStrip) then
    begin
      if Length(List)>0 then
         sup:=TTreeMapItem(Items[List[0]]).Superior
      else
         sup:=-1;

      if sup<0 then
         SetLength(prevRect, Self.Count);

      totalW:=GetTreeSize(List);
      CalcNodesSize(List);
    end;

    for t:=Low(List) to High(List) do
    begin
      tmpIndex:=List[t];

      with TItemAccess(Items[tmpIndex]) do
      begin
        IFormat:=ActiveFormat;
        IFormat.Text:=Text;
        IFormat.Color:=GetValueColor(Index);

        if IFormat.Color<>clNone then  // Null point
           TFormatAccess(IFormat).Draw(ParentChart,ShapeBounds,0,NumTextLines);
      end;

      // Draw outline Hover border:
      if PrepareHoverPen(tmpIndex) then
      begin
        ParentChart.Canvas.Brush.Style:=bsClear;
        ParentChart.Canvas.Rectangle(Items[tmpIndex].ShapeBounds);
      end;
    end;

    for t:=Low(List) to High(List) do
    begin
      tmpRoots:=GetChilds(List[t],True);

      if Length(tmpRoots)>0 then
         DrawChilds(tmpRoots, Succ(Level));
    end;
  end;

var tmpRoots : TIntArray;
begin
  AutoSizeNodes;

  tmpRoots:=GetChilds(-1,True);

  if Length(tmpRoots)>0 then
     DrawChilds(tmpRoots,0);

  prevRect:=nil;
end;

procedure TTreeMapSeries.SetMapStyle(const Value: TTreeMapTiling);
begin
  if FMapStyle<>Value then
  begin
    FMapStyle := Value;
    Repaint;
  end;
end;

function TTreeMapSeries.IsValidSourceOf(Value: TChartSeries): Boolean;
begin
  result:=Value is TTreeMapSeries;
end;

function TTreeMapSeries.NumSampleValues: Integer;
begin
  result:=15;
end;

class function TTreeMapSeries.GetEditorClass: String;
begin
  result:='TTreeMapSeriesEditor';
end;

function TTreeMapSeries.GetItem(Index: Integer): TTreeMapItem;
begin
  result:=TTreeMapItem(Items.Items[index]);
end;

procedure TTreeMapSeries.SetColorStyle(const Value: TTreeMapColorStyle);
begin
  if FColorStyle<>Value then
  begin
    FColorStyle:=Value;
    Repaint;
  end;
end;

procedure TTreeMapSeries.SetItem(Index: Integer; const Value: TTreeMapItem);
begin
  Item[Index]:=Value;
end;

procedure TTreeMapSeries.Assign(Source:TPersistent);
begin
  inherited;

  if Source is TTreeMapSeries then
  with TTreeMapSeries(Source) do
  begin
    Self.FColorStyle:=FColorStyle;
    Self.FMapStyle:=FMapStyle;
    Self.Palette:=FPalette;
  end;
end;

function TTreeMapSeries.Clicked(x, y: Integer): Integer;
var t : Integer;
begin
  result:=TeeNoPointClicked;

  for t:=Min(Items.Count,Count)-1 downto 0 do
  if PointInRect(Items[t].ShapeBounds,x,y) then
  begin
    result:=t;
    break;
  end;
end;

function TTreeMapSeries.GetPaletteSteps: Integer;
begin
  result:=FPalette.PaletteSteps;
end;

procedure TTreeMapSeries.SetPaletteSteps(const Value: Integer);
begin
  FPalette.PaletteSteps:=Value;
end;

{ TTreeMapItem }
function TTreeMapItem.GetValue: TChartValue;
begin
  result:=Series.MandatoryValueList[Index];
end;

procedure TTreeMapItem.SetValue(const Value: TChartValue);
begin
  Series.MandatoryValueList[Index]:=Value;
end;

initialization
  RegisterTeeSeries( TTreeMapSeries, @TeeMsg_GalleryTreeMapSeries,
                                 @TeeMsg_GalleryExtended, 1);
finalization
  UnRegisterTeeSeries([TTreeMapSeries]);
end.
