{**********************************************}
{   TeeChart Database Cross-Tab Source         }
{   Copyright (c) 1996-2020 by Steema Software }
{**********************************************}
unit TeeDBCrossTab;
{$I TeeDefs.inc}

interface

{ The procedure below creates an array of Chart Series
  and fills them using the DataSet parameter.

  The Series are created using the "AGroupField" parameter.

  The "ASeries" parameter will be used to duplicate it many times,
  one for each "group", thus using it as a template.

  Example of use:
  ---------------

  Imagine you have a table with "Product sales".

  In this table you have the following fields:

  Product    ( Cars, Bikes, Trucks... )
  Country    ( USA, UK, Germany, Australia... )
  Amount     ( $1234... )

  Now we want to create a crosstab Chart consisting of one Bar
  Series for each "Product", each one showing the sum of
  "Amount" for each "Country".

  So,
  our "GroupField" is "Product",
  our "LabelField" is "Country" and
  our "ValueField" is "Amount".

  Choose between 1 or 2:

  1) Calling a direct global procedure:

  FillDataSet( Table1, BarSeries1, "Product", "Country", "Amount", gfSum );

  After calling this procedure, the Chart will show several Series,
  one for each "Product".
  Each series will show the "Sum of Amount" by "Country".

  You can access and modify these Series as usually, like for example
  changing the Series Color, Title, etc.

  2) Use a TDBCrossTabSource component, set properties and Active:=True;

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

  DB,

  {$IFDEF FMX}
  FMXTee.Chart, FMXTee.DBChart, FMXTee.Engine, FMXTee.Procs, FMXTee.Canvas
  {$ELSE}
  Chart, DBChart, TeEngine, TeeProcs, TeCanvas
  {$ENDIF}
  ;

type
  { Count records, sum record values, or find min or max }
  TGroupFormula = (gfCount, gfSum, gfMin, gfMax);

  // Base class, non DB
  TCrossTabSource=class(TTeeSeriesDBSource,ITeeEventListener)
  private
    FCase       : Boolean;
    FFormula    : TGroupFormula;
    FGroup      : String;
    FHideSeries : Boolean;
    FLabel      : String;
    FValue      : String;

    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    IParentChart: TCustomAxisPanel;

    function DetailList:TCustomSeriesList;
    procedure RemoveSeries;
    procedure SetCase(const Value: Boolean);
    procedure SetFormula(const Value: TGroupFormula);
    procedure SetGroup(const Value: String);
    procedure SetIParentChart(const Value:TCustomAxisPanel);
    procedure SetLabel(const Value: String);
    procedure SetValue(const Value: String);
  protected
    function FindGroup(const AGroup:String):TChartSeries;
    procedure InitLoop;
    function LocateSeries(const ATitle:String):TChartSeries;
    procedure NewPoint(const ASeries:TChartSeries; AIndex:Integer;
                       const AValue:TChartValue; const ALabel:String);
    function NewSeries:TChartSeries;
    procedure SetSeries(const Value: TChartSeries); override;
    procedure TeeEvent(Event: TTeeEvent);
  public
    UseDetail : Boolean; // default=True (use Series.Detail children)

    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
  published
    property Active;
    property CaseSensitive:Boolean read FCase write SetCase default True;
    property Formula:TGroupFormula read FFormula write SetFormula default gfSum;
    property GroupField:String read FGroup write SetGroup;
    property HideSeries:Boolean read FHideSeries write FHideSeries default True;
    property LabelField:String read FLabel write SetLabel;
    property Series;
    property ValueField:String read FValue write SetValue;
  end;

  {$IFDEF D16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 {$IFDEF D26}or pidOSX64{$ENDIF})]
  {$ENDIF}
  TDBCrossTabSource=class(TCrossTabSource)
  private
    FDataSet    : TDataSet;
    LoadingDS   : Boolean;

    ISource : TDBChartDataSource;

    procedure DataSourceCheckDataSet(const ADataSet: TDataSet);
    procedure DataSourceCloseDataSet(const ADataSet: TDataSet);
    Procedure LoadDataSet;
    procedure SetDataSet(const Value: TDataSet);
  protected
    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetActive(const Value:Boolean); override;
  public
    Destructor Destroy; override;

    class Function Available(AChart: TCustomAxisPanel):Boolean; override;
    class Function Description:String; override;
    class Function Editor:TComponentClass; override;
    class Function HasSeries(ASeries:TChartSeries):Boolean; override;
    Procedure Load; override;
  published
    property DataSet:TDataSet read FDataSet write SetDataSet;
  end;

Procedure FillDataSet( const ADataSet:TDataSet;
                       const ASeries:TChartSeries;
                       const AGroupField,ALabelField,AValueField:String;
                       const GroupFormula:TGroupFormula);

implementation

uses
  {$IFDEF D16}
  System.Types,
  {$ENDIF}
  {$IFDEF FMX}
  FMXTee.Constants
  {$ELSE}
  TeeConst
  {$ENDIF}
  ;

{ Create a cross-tab of Series using DataSet records. }
Procedure FillDataSet( const ADataSet:TDataSet;
                       const ASeries:TChartSeries;
                       Const AGroupField,ALabelField,AValueField:String;
                       const GroupFormula:TGroupFormula);
begin
  with TDBCrossTabSource.Create(nil) do
  try
    Series:=ASeries;
    DataSet:=ADataSet;

    GroupField:=AGroupField;
    LabelField:=ALabelField;
    ValueField:=AValueField;
    Formula:=GroupFormula;

    Open;
  finally
    Free;
  end;
end;

{ TCrossTabSource }

Constructor TCrossTabSource.Create(AOwner: TComponent);
begin
  inherited;

  FFormula:=gfSum;
  FCase:=True;
  FHideSeries:=True;

  UseDetail:=True;
end;

Destructor TCrossTabSource.Destroy;
begin
  SetIParentChart(nil);
  inherited;
end;

procedure TCrossTabSource.TeeEvent(Event: TTeeEvent);
begin
  if (Event is TTeeSeriesEvent) and
     (TTeeSeriesEvent(Event).Event=seRemove) and
     Assigned(Series) and (TTeeSeriesEvent(Event).Series=Series) then
  begin
    //If Series is removed, remove associated series
    RemoveSeries;
  end;
end;

procedure TCrossTabSource.RemoveSeries;
var t : Integer;
begin
  if UseDetail then
  begin
    while Series.Detail.Count>0 do
          {$IFDEF AUTOREFCOUNT}
          Series.Detail[0].DisposeOf;
          {$ELSE}
          Series.Detail[0].Free;
          {$ENDIF}
  end
  else
  begin
    if Assigned(Series.ParentChart) then
    begin
      t:=0;

      with Series.ParentChart do
      while t<SeriesCount do
        if (Series[t]<>Self.Series) and (TChartSeries(Series[t].Tag)=Self.Series) then
            {$IFDEF AUTOREFCOUNT}
            Series[t].DisposeOf
            {$ELSE}
            Series[t].Free
            {$ENDIF}
        else
          Inc(t);
    end;

    if not (csDestroying in Series.ComponentState) then
    begin
      Series.Clear;
      Series.Title:='';
    end;
  end;
end;

procedure TCrossTabSource.SetSeries(const Value: TChartSeries);
begin
  inherited;
  SetIParentChart(nil);
end;

procedure TCrossTabSource.SetCase(const Value: Boolean);
begin
  if FCase<>Value then
  begin
    Close;
    FCase:=Value;
  end;
end;

procedure TCrossTabSource.SetFormula(const Value: TGroupFormula);
begin
  if FFormula<>Value then
  begin
    Close;
    FFormula:=Value;
  end;
end;

procedure TCrossTabSource.SetGroup(const Value: String);
begin
  if FGroup<>Value then
  begin
    Close;
    FGroup:=Value;
  end;
end;

procedure TCrossTabSource.SetLabel(const Value: String);
begin
  if FLabel<>Value then
  begin
    Close;
    FLabel:=Value;
  end;
end;

procedure TCrossTabSource.SetValue(const Value: String);
begin
  if FValue<>Value then
  begin
    Close;
    FValue:=Value;
  end;
end;

function TCrossTabSource.DetailList:TCustomSeriesList;
begin
  if UseDetail then
     result:=Series.Detail
  else
     result:=Series.ParentChart.SeriesList;
end;

function TCrossTabSource.LocateSeries(Const ATitle:String):TChartSeries;
var t : Integer;
    tmpList : TCustomSeriesList;
begin
  tmpList:=DetailList;

  if FCase then
  begin
    for t:=0 to tmpList.Count-1 do
        if tmpList[t].Title=ATitle then
        begin
          result:=tmpList[t];
          exit;
        end;
  end
  else
    for t:=0 to tmpList.Count-1 do
        if SameText(tmpList[t].Title,ATitle) then
        begin
          result:=tmpList[t];
          exit;
        end;

  result:=nil;
end;

type
  TChartAccess=class(TCustomAxisPanel);

procedure TCrossTabSource.SetIParentChart(const Value:TCustomAxisPanel);
begin
  if Assigned(IParentChart) then
     TChartAccess(IParentChart).RemoveListener(Self);

  IParentChart:=Value;

  if Assigned(IParentChart) then
     TChartAccess(IParentChart).AddListener(Self);
end;

procedure TCrossTabSource.InitLoop;
begin
  SetIParentChart(Series.ParentChart);
  RemoveSeries;
end;

type
  TSeriesAccess=class(TChartSeries);

function TCrossTabSource.NewSeries:TChartSeries;
var t : Integer;
    tmpSeries : TChartSeries;
begin
  if UseDetail then
     result:=Series.Detail.CreateNew(Series)
  else
  begin
    result:=CreateNewSeries(Series.Owner,Series.ParentChart,TChartSeriesClass(Series.ClassType));
    TSeriesAccess(result).ManualData:=True;
  end;

  result.AssignFormat(Series);
  result.ShowInLegend:=Series.ShowInLegend;

  if UseDetail then
     result.ParentChart:=Series.ParentChart
  else
     result.Active:=Series.Active;

  result.Brush:=Series.Brush;
  result.Pen:=Series.Pen;
  TSeriesAccess(result).DontSerialize:=True;
  result.ShowInEditor:=not HideSeries;

  result.SeriesColor:=Series.ParentChart.GetFreeSeriesColor;

  tmpSeries:=nil;

  if UseDetail then
  begin
    if Series.Detail.Count>0 then
       tmpSeries:=Series.Detail[0];
  end
  else
  begin
    result.Tag:=ObjectToTag(Series);
    tmpSeries:=Series;
  end;

  result.BeginUpdate;
  try
    for t:=0 to tmpSeries.Count-1 do
        result.Add(0,tmpSeries.Labels[t]);
  finally
    result.EndUpdate;
  end;
end;

procedure TCrossTabSource.NewPoint(const ASeries:TChartSeries; AIndex:Integer;
                                   const AValue:TChartValue; const ALabel:String);
var t,
    tt : Integer;
    tmpNull : Boolean;
    tmpList : TCustomSeriesList;
begin
  if AIndex=-1 then
  begin
    ASeries.Add(AValue,ALabel,clTeeColor);

    // Add an empty point into all the other series

    tmpList:=DetailList;

    for t:=0 to tmpList.Count-1 do
    if ASeries<>tmpList[t] then
       if ASeries.Count>tmpList[t].Count then
          for tt:=1 to (ASeries.Count-tmpList[t].Count) do
              tmpList[t].AddNull(ALabel);
  end
  else
  begin
    tmpNull:=ASeries.IsNull(AIndex);

    with ASeries.MandatoryValueList do
    case Formula of
      gfCount,
      gfSum : Value[AIndex]:=Value[AIndex]+AValue;

      gfMin: if tmpNull or (AValue<Value[AIndex]) then
                Value[AIndex]:=AValue;
    else
      // gfMax

      if tmpNull or (AValue>Value[AIndex]) then
         Value[AIndex]:=AValue;
    end;

    if tmpNull then
       ASeries.SetNull(AIndex,False);
  end;
end;

function TCrossTabSource.FindGroup(const AGroup:String):TChartSeries;
begin
  result:=LocateSeries(AGroup);

  if result=nil then
  begin
    if UseDetail then
       result:=NewSeries
    else
    if Series.Title='' then
       result:=Series
    else
       result:=NewSeries;

    result.Title:=AGroup;
  end;
end;

{ TDBCrossTabSource }

Destructor TDBCrossTabSource.Destroy;
begin
  ISource.Free;
  inherited;
end;

Procedure TDBCrossTabSource.LoadDataSet;

  procedure FinishLoop(const ABookMark:TBookMark);
  begin
    DataSet.GotoBookMark(ABookMark);
    DataSet.FreeBookmark(ABookMark);
    DataSet.EnableControls;

    TChartAccess(Series.ParentChart).BroadcastSeriesEvent(Series,seAdd);

    if UseDetail then
    begin
      Series.Detail.ReCalculate;
      Series.Visible:=False;
    end;
  end;

var tmpSeries  : TChartSeries;
    tmpLabel   : String;
    tmpValue   : Double;
    tmpPoint   : Integer;
    tmpBookMark : TBookMark;
    tmpGroupField,
    tmpValueField,
    tmpLabelField : TField;
begin
  if not LoadingDS then
  begin
    LoadingDS:=True;
    try
      InitLoop;

      tmpBookMark:=DataSet.GetBookMark;
      DataSet.DisableControls;

      try
        if LabelField='' then tmpLabelField:=nil
                         else tmpLabelField:=DataSet.FieldByName(LabelField);

        if GroupField='' then
        begin
          if UseDetail then
             tmpSeries:=NewSeries
          else
             tmpSeries:=Series;

          tmpSeries.Title:=ValueField;
          tmpGroupField:=nil;
        end
        else
        begin
          tmpSeries:=nil;
          tmpGroupField:=DataSet.FieldByName(GroupField);
        end;

        tmpValueField:=DataSet.FieldByName(ValueField);

        tmpValue:=1;

        DataSet.First;

        while not DataSet.Eof do
        begin
          if GroupField<>'' then
             tmpSeries:=FindGroup(tmpGroupField.AsString);

          if Formula<>gfCount then
             tmpValue:=tmpValueField.AsFloat;

          if not Assigned(tmpLabelField) then
          begin
            tmpLabel:='';

            if tmpSeries.Count>0 then tmpPoint:=0
                                 else tmpPoint:=-1;
          end
          else
          begin
            tmpLabel:=tmpLabelField.AsString;
            tmpPoint:=tmpSeries.Labels.IndexOfLabel(tmpLabel,FCase);
          end;

          NewPoint(tmpSeries,tmpPoint,tmpValue,tmpLabel);

          DataSet.Next;
        end;
      finally
        FinishLoop(tmpBookMark);
      end;
    finally
      LoadingDS:=False;
    end;
  end;
end;

class function TDBCrossTabSource.Description: String;
begin
  result:=TeeMsg_CrossTab;
end;

class function TDBCrossTabSource.Editor: TComponentClass;
var tmp : TClass;
begin
  tmp:=TeeGetClass('TDBChartCrossTabEditor');

  if Assigned(tmp) then
     result:=TComponentClass(tmp)
  else
     result:=nil;
end;

class function TDBCrossTabSource.HasSeries(ASeries: TChartSeries): Boolean;
begin
  result:=(ASeries.DataSource is TDBCrossTabSource);
end;

procedure TDBCrossTabSource.Load;
begin
  if Assigned(Series) and Assigned(DataSet) and
     (ValueField<>'') and DataSet.Active then
  begin
    Series.BeginUpdate;
    try
      RemoveSeries;
      LoadDataSet;
    finally
      Series.EndUpdate;
    end;
  end;
end;

type
  TDBChartDataSourceAccess=class(TDBChartDataSource);

procedure TDBCrossTabSource.SetDataSet(const Value: TDataSet);
begin
  if FDataSet<>Value then
  begin
    if Assigned(FDataSet) then
       FDataSet.RemoveFreeNotification(Self);

    Close;

    FDataSet:=Value;

    ISource.Free;
    ISource:=TDBChartDataSource.Create(nil);

    if Assigned(FDataSet) then
    begin
      FDataSet.FreeNotification(Self);
      TDBChartDataSourceAccess(ISource).SetDataSet(FDataSet);
    end;

    TDBChartDataSourceAccess(ISource).OnCheckDataSet:=DataSourceCheckDataSet;
    TDBChartDataSourceAccess(ISource).OnCloseDataSet:=DataSourceCloseDataSet;
  end;
end;

Procedure TDBCrossTabSource.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) and Assigned(FDataSet) and (AComponent=FDataSet) then
     DataSet:=nil;
end;

procedure TDBCrossTabSource.DataSourceCloseDataSet(const ADataSet: TDataSet);
begin
  if (not KeepDataOnClose) and Assigned(Series) then
     RemoveSeries;
end;

procedure TDBCrossTabSource.SetActive(const Value:Boolean);
begin
  inherited;

  if not Active then
     DataSourceCloseDataSet(DataSet);
end;

procedure TDBCrossTabSource.DataSourceCheckDataSet(const ADataSet: TDataSet);
begin
  Refresh;
end;

class function TDBCrossTabSource.Available(AChart: TCustomAxisPanel):Boolean;
begin
  result:=AChart is TCustomChart;
end;

initialization
  TeeActivateGroup;
  RegisterClass(TDBCrossTabSource);
  TeeSources.Add(TDBCrossTabSource);
finalization
  TeeSources.Remove(TDBCrossTabSource);
end.
