{********************************************}
{ TDBChart Component                         }
{ Copyright (c) 1995-2020 by Steema Software }
{ All rights Reserved                        }
{********************************************}
unit DBChart;
{$I TeeDefs.inc}

interface

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

  SysUtils, Classes,

  {$IFDEF D18}
  System.Generics.Collections,
  {$ENDIF}

  {$IFDEF D6}
  DateUtils,
  {$ENDIF}

  {$IFDEF FMX}
  System.UITypes, FMX.Types,

  {$IFDEF D19}
  FMX.Graphics, // Hint
  {$ENDIF}
  
  {$ELSE}
  Graphics, Controls, Menus, Forms, Dialogs, ExtCtrls, StdCtrls,
  {$ENDIF}

  DB,

  {$IFDEF FMX}
  FMXTee.Canvas, FMXTee.Chart, FMXTee.Engine
  {$ELSE}
  Chart, TeEngine
  {$ENDIF}
  ;

type
  DBChartException=class(Exception);

  TTeeDBGroup=(dgHour,dgDay,dgWeek,dgWeekDay,dgMonth,dgQuarter,dgYear,dgNone);

  TListOfDataSources=class({$IFDEF D18}TObjectList<TDataSource>{$ELSE}TList{$ENDIF})
  private
    procedure Put(Index:Integer; const Value:TDataSource);
    function Get(Index:Integer):TDataSource;
  public
    {$IFNDEF D18}
    Procedure Clear; override;
    {$ENDIF}

    function IndexOf(const ADataSet: TDataSet): Integer;

    property DataSource[Index:Integer]:TDataSource read Get write Put; default;
  end;

  TCustomDBChart=class;

  TProcessRecordEvent=Procedure(Sender:TCustomDBChart; DataSet:TDataSet) of object;

  TCustomDBChart = class(TCustomChart)
  private
    FAutoRefresh     : Boolean;
    FRefreshInterval : Integer;
    FShowGlassCursor : Boolean;
    FOnProcessRecord : TProcessRecordEvent;

    { internal }
    IUpdating        : Boolean;
    ITimer           : TTimer;
    IDataSources     : TListOfDataSources;

    Procedure DataSourceCheckDataSet(const ADataSet:TDataSet);
    Procedure DataSourceCloseDataSet(const ADataSet:TDataSet);
    Procedure CheckDataSet(const ADataSet:TDataSet; const ASeries:TChartSeries=nil);
    procedure CheckNewDataSource(const ADataSet:TDataSet; SingleRow:Boolean);
    Procedure SetRefreshInterval(Value:Integer);
    Procedure CheckTimer;
    Procedure OnRefreshTimer(Sender:TObject);
  protected
    function CreateDataSource(const AOwner:TComponent; const ADataSet:TDataSet; SingleRow:Boolean):TDataSource;
    procedure RemovedDataSource( ASeries: TChartSeries;
                                 AComponent: TComponent ); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Procedure CheckDatasource(ASeries:TChartSeries); override;
    Function IsValidDataSource(ASeries:TChartSeries; AComponent:TComponent):Boolean; override;

    Procedure FillValueSourceItems( AValueList:TChartValueList; Proc:TGetStrProc); override;
    Procedure FillSeriesSourceItems( ASeries:TChartSeries; Proc:TGetStrProc); override;

    Procedure RefreshDataSet(const ADataSet:TDataSet; const ASeries:TChartSeries);
    Procedure RefreshData;

    { properties }
    property AutoRefresh:Boolean read FAutoRefresh write FAutoRefresh default True;
    property RefreshInterval:Integer read FRefreshInterval write SetRefreshInterval default 0;
    property ShowGlassCursor:Boolean read FShowGlassCursor write FShowGlassCursor default True;

    { events }
    property OnProcessRecord:TProcessRecordEvent read FOnProcessRecord
                                                 write FOnProcessRecord;
  published
    function DataSourcesCount: Integer;
    procedure ClearDataSources;
  end;

  {$IFDEF D16}
  [ComponentPlatformsAttribute(TeeAllComponentPlatformIDs)]
  {$ENDIF}
  TDBChart=class(TCustomDBChart)
  published
    { TCustomDBChart properties }
    property AutoRefresh;
    property RefreshInterval;
    property ShowGlassCursor;
    { TCustomDBChart events }
    property OnProcessRecord;

    { TCustomChart Properties }
    property AllowPanning;
    property BackImage;
    property BackImageInside;
    property BackImageMode;
    property BackImageTransp;
    property BackWall;
    property Border;
    property BorderRound;
    property BottomWall;
    property Foot;
    property Gradient;
    property LeftWall;
    property MarginBottom;
    property MarginLeft;
    property MarginRight;
    property MarginTop;
    property MarginUnits;
    property PrintProportional;
    property RightWall;
    property ScrollMouseButton;
    property SubFoot;
    property SubTitle;
    property Title;

    { TCustomChart Events }
    property OnAllowScroll;
    property OnClickAxis;
    property OnClickBackground;
    property OnClickLegend;
    property OnClickSeries;
    property OnClickTitle;
    property OnGetLegendPos;
    property OnGetLegendRect;
    property OnScroll;
    property OnUndoZoom;
    property OnZoom;

    { TCustomAxisPanel properties }
    property Animations;
    property AxisBehind;
    property AxisVisible;
    property BottomAxis;
    property Chart3DPercent;
    property ClipPoints;
    property CustomAxes;
    property DepthAxis;
    property DepthTopAxis;
    property Emboss;
    property Frame;
    property Hover;
    property LeftAxis;
    property Legend;
    property Monochrome;
    property Pages;
    property Panning;
    property RightAxis;
    property SeriesGroups;
    property SeriesList;
    property Shadow;
    property Tools;
    property TopAxis;
    property View3D;
    property View3DOptions;
    property View3DWalls;
    property Zoom;
    property ZoomWheel;

    { TCustomAxisPanel events }
    property OnAddSeries;
    property OnAfterDraw;
    property OnBeforeDrawAxes;
    property OnBeforeDrawChart;
    property OnBeforeDrawSeries;
    property OnBeforePrint;
    property OnGetAxisLabel;
    property OnGetLegendText;
    property OnGetNextAxisLabel;
    property OnPageChange;
    property OnRemoveSeries;
    property OnValidDataSource;
    
    { TPanel properties }
    property Align;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderWidth;
    property Color;

    {$IFNDEF FMX}
    property DragCursor;
    {$ENDIF}

    property DragMode;
    property Enabled;

    {$IFDEF FMX}
    {$IFDEF D23}
    property ParentShowHint;
    {$ENDIF}
    {$ELSE}
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property TabStop;
    {$ENDIF}

    property ShowHint;
    property TabOrder;

    {$IFNDEF FMX}
    {$IFDEF D14}
    property Touch;
    {$ENDIF}
    {$ENDIF}

    property Visible;

    {$IFDEF FMX}

    {$IFDEF D17}
    property Action;
    property Anchors;
    {$ENDIF}

    property ClipParent default False;
    property Cursor default crDefault;

    {$IFNDEF D21} // Removed in XE7
    property DesignVisible default True;
    {$ENDIF}
    
    property EnableDragHighlight default True;
    property Height;
    property HitTest default True;
    property Margins;
    property Opacity;
    property Padding;
    property PopupMenu;
    property Position;
    property RotationAngle;
    property RotationCenter;
    property Scale;

    {$IFDEF D21}
    property Size;
    {$ENDIF}

    property Width;

    {$ELSE}
    property Anchors;
    {$ENDIF}

    {$IFDEF FMX}
    property OnDragEnter;
    property OnDragLeave;
    property OnDragEnd;
    property OnEnter;
    property OnExit;
    property OnPainting;
    property OnPaint;
    property OnApplyStyleLookup;
    property OnCanFocus;

    property ClipChildren default True;
    property Locked;
    {$ELSE}

    property AutoSize;
    property Constraints;
    property DragKind;
    {$IFNDEF LCL}
    property Locked;
    {$ENDIF}
    {$ENDIF}

    { TPanel events }
    property OnClick;

    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;

    {$IFNDEF FMX}
    property OnContextPopup;
    property OnEndDrag;
    property OnStartDrag;
    property OnEnter;
    property OnExit;
    property OnKeyPress;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    {$ENDIF}

    property OnKeyDown;

    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnResize;

    {$IFNDEF FMX}
    {$IFNDEF LCL}
    property OnCanResize;
    {$ENDIF}
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;

    {$IFDEF D14}
    property OnGesture;
    {$ENDIF}

    property OnGetSiteInfo;
    property OnStartDock;
    property OnUnDock;
    {$ENDIF}

    {$IFDEF D10}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF}
  end;

  TTeeOnGetFieldType=procedure(const AType:TFieldType; var TeeType:TTeeFieldType);

  // Use to override VCL TFieldType conversion to number, text or date-time.
  //
  // For example in special cases (ie: Devart.com\Oracle), TFieldType is hardcoded
  // to non-existant values:
  {
  procedure MyFieldType(const AType:TFieldType; var TeeType:TTeeFieldType);
  begin
    if Ord(AType)=107 then TeeType:=tftNumber;
  end;

  ...
  TeeOnGetFieldType:=MyFieldType;
  ...
  }

var
  TeeOnGetFieldType : TTeeOnGetFieldType=nil;

{ given a VCL "database field type", this function returns
  a more simplified "type": (number, date, text) }
Function TeeFieldType(AType:TFieldType):TTeeFieldType;

{ Returns the ISO- Week number (from 1 to 52) of a given "ADate" parameter,
  and decrements "Year" if it's the first week of the year. }
Function DateToWeek(ADate:TDateTime; Var Year:Word):Integer;

{ same as DateToWeek, using a different algorithm
  (compatible with TeeChart version 4 }
Function DateToWeekOld(Const ADate:TDateTime; Var Year:Word):Integer;

{ internal, used by DBChart Summary feature }
Function TeeGetDBPart(Num:Integer; St:String):String;
Function StrToDBGroup(St:String):TTeeDBGroup;
Function StrToDBOrder(St:String):TChartListOrder;

type
  TCheckDataSetEvent=procedure(const DataSet:TDataSet) of object;

  TDBChartDataSource=class(TDataSource)
  private
    FDBChart   : TCustomDBChart;
    FWasActive : Boolean;

    Procedure DataSourceRowChange(Sender:TObject; Field:TField);
    Procedure DataSourceStateChange(Sender:TObject);
    Procedure DataSourceUpdateData(Sender:TObject);
  protected
    OnCheckDataSet : TCheckDataSetEvent;
    OnCloseDataSet : TCheckDataSetEvent;

    Procedure SetDataSet(const Value:TDataSet; SingleRow:Boolean=False);
  end;

  TTeeSeriesDBSource=class(TTeeSeriesSource)
  public
    class Function Available(AChart:TCustomAxisPanel):Boolean; override;
    class function HasNew: Boolean; override;
  end;

Procedure FillDataSetFields(const DataSet:TDataSet; const Proc:TGetStrProc);

implementation

uses
     {$IFDEF FMX}
     FMXTee.Procs, FMXTee.Constants,
     {$ELSE}
     TeeProcs, TeeConst,
     {$ENDIF}

     TypInfo

     {$IFDEF AXUNICODE}
     ,TeeUnicode
     {$ENDIF}
     ;
     
{ TDBChartDataSource }

Procedure TDBChartDataSource.SetDataSet(const Value:TDataSet; SingleRow:Boolean=False);
Begin
  DataSet:=Value;
  FWasActive:=DataSet.Active;

  OnStateChange:=DataSourceStateChange;
  OnUpdateData:=DataSourceUpdateData;

  if SingleRow then
     OnDataChange:=DataSourceRowChange;
end;

Procedure TDBChartDataSource.DataSourceRowChange(Sender:TObject; Field:TField);
begin
  if Assigned(FDBChart) then
     if not FDBChart.IUpdating then
        With TDBChartDataSource(Sender) do OnCheckDataSet(DataSet);
end;

Procedure TDBChartDataSource.DataSourceUpdateData(Sender:TObject);
Begin
  With TDBChartDataSource(Sender) do
  if State=dsBrowse then OnCheckDataSet(DataSet)
                    else FWasActive:=False;
End;

Procedure TDBChartDataSource.DataSourceStateChange(Sender:TObject);
Begin
  With TDBChartDataSource(Sender) do
  if State=dsInactive then
  Begin
    FWasActive:=False;
    if Assigned(OnCloseDataSet) then OnCloseDataSet(DataSet);
  end
  else
  if (State=dsBrowse) and (not FWasActive) then
  Begin
    OnCheckDataSet(DataSet);
    FWasActive:=True;
  end;
end;

{ TListOfDataSources }

{$IFNDEF D18}
Procedure TListOfDataSources.Clear;
var t : Integer;
begin
  for t:=0 to Count-1 do DataSource[t].Free;
  inherited;
end;
{$ENDIF}

function TListOfDataSources.IndexOf(const ADataSet: TDataSet): Integer;
var t : Integer;
begin
  for t:=0 to Count-1 do
      if DataSource[t].DataSet=ADataSet then
      begin
        result:=t;
        exit;
      end;

  result:=-1;
end;

procedure TListOfDataSources.Put(Index:Integer; const Value:TDataSource);
begin
  inherited Items[Index]:=Value;
end;

function TListOfDataSources.Get(Index:Integer):TDataSource;
begin
  result:=TDataSource(inherited Items[Index]);
end;

{ TDBChart }

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

  // Note: Investigate: What is the reason to pass False here?
  IDataSources:=TListOfDataSources.Create{$IFDEF D18}(False){$ENDIF};

  FAutoRefresh:=True;
  FShowGlassCursor:=True;
  ITimer:=nil;
  IUpdating:=False;
end;

Destructor TCustomDBChart.Destroy;

  {$IFDEF D18}
  // Note: This shouldn't be necessary if TListOfDataSources were created
  // as "OwnsObjects = True"
  procedure FreeDataSources;
  var t : Integer;
  begin
    for t:=0 to IDataSources.Count-1 do
        IDataSources[t].{$IFDEF AUTOREFCOUNT}DisposeOf{$ELSE}Free{$ENDIF};
  end;
  {$ENDIF}

begin
  ITimer.Free;

  {$IFDEF D18}
  FreeDataSources;
  {$ENDIF}

  FreeAndNil(IDataSources);
  inherited;
end;

// When "AComponent" source is removed from ASeries DataSourceList,
// this method also removes AComponent from internal IDataSources list.
procedure TCustomDBChart.RemovedDataSource( ASeries: TChartSeries;
                                            AComponent: TComponent );
var t   : Integer;
    tmp : TDataSet;
begin
  inherited;

  if Assigned(IDataSources) and (AComponent is TDataSet) then
  for t:=0 to IDataSources.Count-1 do
  begin
    tmp:=IDataSources[t].DataSet;

    if (not Assigned(tmp)) or (tmp=AComponent) then
    begin
      {$IFNDEF AUTOREFCOUNT}
      IDataSources[t].Free;
      {$ENDIF}

      IDataSources.Delete(t);

      break;
    end;
  end;
end;

function TCustomDBChart.DataSourcesCount: Integer;
begin
  Result:=IDataSources.Count;
end;

Procedure TCustomDBChart.ClearDataSources;
begin
  IDataSources.Clear;
end;

Procedure TCustomDBChart.CheckTimer;
Begin
  if Assigned(ITimer) then ITimer.Enabled:=False;
  if (FRefreshInterval>0) and (not (csDesigning in ComponentState) ) then
  Begin
    if not Assigned(ITimer) then
    Begin
      ITimer:=TTimer.Create(Self);
      ITimer.Enabled:=False;
      ITimer.OnTimer:=OnRefreshTimer;
    end;

    ITimer.Interval:=FRefreshInterval*1000;
    ITimer.Enabled:=True;
  end;
end;

procedure TCustomDBChart.OnRefreshTimer(Sender:TObject);
var t : Integer;
begin
  if Assigned(IDataSources) then
  begin
    ITimer.Enabled:=False;  { no try..finally here ! }

    for t:=0 to IDataSources.Count-1 do
    With IDataSources[t] do
    if DataSet.Active then
    Begin
      DataSet.Refresh;
      CheckDataSet(DataSet);
    end;

    ITimer.Enabled:=True;
  end;
end;

Procedure TCustomDBChart.SetRefreshInterval(Value:Integer);
Begin
  if (Value<0) or (Value>60) then
     Raise DBChartException.Create(TeeMsg_RefreshInterval);

  FRefreshInterval:=Value;
  CheckTimer;
End;

Function TCustomDBChart.IsValidDataSource(ASeries:TChartSeries; AComponent:TComponent):Boolean;
Begin
  result:=(AComponent is TDataSet) or (AComponent is TDataSource);

  if result then
  begin
    if Assigned(FOnValidDataSource) then
       FOnValidDataSource(Self,ASeries,AComponent,result);
  end
  else
    result:=inherited IsValidDataSource(ASeries,AComponent);
end;

function TCustomDBChart.CreateDataSource(const AOwner:TComponent; const ADataSet:TDataSet; SingleRow:Boolean):TDataSource;
begin
  result:=TDBChartDataSource.Create(AOwner);

  with TDBChartDataSource(result) do
  begin
    SetDataSet(ADataSet,SingleRow);

    OnCheckDataSet:=DataSourceCheckDataSet;
    OnCloseDataSet:=DataSourceCloseDataSet;

    FDBChart:=Self;
  end;
end;

procedure TCustomDBChart.CheckNewDataSource(const ADataSet:TDataSet; SingleRow:Boolean);
Begin
  if Assigned(IDataSources) and (IDataSources.IndexOf(ADataSet)=-1) then
     IDataSources.Add(CreateDataSource(nil, ADataSet, SingleRow));
end;

Procedure TCustomDBChart.CheckDatasource(ASeries:TChartSeries);
Begin
  if Assigned(ASeries) then
  With ASeries do
    if ParentChart=Self then
    Begin
      if Assigned(DataSource) then
      Begin
        ASeries.Clear;

        if DataSource is TDataSet then
        Begin
          CheckNewDataSource(TDataSet(DataSource),False);
          CheckDataSet(TDataSet(DataSource),ASeries);
        end
        else
        if (DataSource is TDataSource) and Assigned(TDataSource(DataSource).DataSet) then
        begin
          CheckNewDataSource(TDataSource(DataSource).DataSet,True);
          CheckDataSet(TDataSource(DataSource).DataSet,ASeries);
        end
        else inherited;
      end
      else inherited;
    end
    else Raise ChartException.Create(TeeMsg_SeriesParentNoSelf);
end;

Procedure TCustomDBChart.CheckDataSet(const ADataSet:TDataSet; const ASeries:TChartSeries=nil);
Begin
  if FAutoRefresh then RefreshDataSet(ADataSet,ASeries);
end;

Procedure TCustomDBChart.DataSourceCheckDataSet(const ADataSet:TDataSet);
begin
  CheckDataSet(ADataSet);
end;

Procedure TCustomDBChart.DataSourceCloseDataSet(const ADataSet:TDataSet);
var t : Integer;
begin
  if FAutoRefresh then
     for t:=0 to SeriesCount-1 do
         if Series[t].DataSource=ADataSet then Series[t].Clear;
end;

type TValueListAccess=class(TChartValueList);

     TDBChartAgg=(dcaNone, dcaSum, dcaCount, dcaHigh, dcaLow, dcaAverage);
     TDBChartSeries=packed record
        ASeries     : TChartSeries;
        YManda      : Boolean;
        MandaList   : TChartValueList;
        LabelSort   : TChartListOrder;
        LabelField  : TField;
        ColorField  : TField;
        MandaField  : TField;
        NumFields   : Integer;
        GroupPrefix : TTeeDBGroup;
        AggPrefix   : TDBChartAgg;
     end;

     TDBChartSeriesList=Array of TDBChartSeries;

Procedure TCustomDBChart.RefreshDataSet(const ADataSet:TDataSet; const ASeries:TChartSeries);
Var HasAnyDataSet : Boolean;

  Procedure ProcessRecord(const tmpSeries:TDBChartSeries);
  var tmpxLabel : String;
      tmpColor  : TColor;
      tmpNotMand: Double;
      tmpMand   : Double;

    Procedure AddToSeries(const DestSeries:TDBChartSeries);
    Var t        : Integer;
        tmpIndex : Integer;
    begin
      With DestSeries do
      if AggPrefix<>dcaNone then
      begin
        tmpIndex:=ASeries.Labels.IndexOfLabel(tmpXLabel);

        if tmpIndex=-1 then { new point }
        begin
          if AggPrefix=dcaCount then tmpMand:=1
          else
          if AggPrefix=dcaAverage then tmpColor:=1;

          if (GroupPrefix=dgNone) then
            ASeries.Add(tmpMand,tmpXLabel,tmpColor)
          else
            ASeries.AddXY(tmpNotMand,tmpMand,tmpXLabel,tmpColor);
        end
        else { existing point, do aggregation }
        With MandaList do
        Case AggPrefix of
          dcaSum:   Value[tmpIndex]:=Value[tmpIndex]+tmpMand;
          dcaCount: Value[tmpIndex]:=Value[tmpIndex]+1;
          dcaHigh:  if tmpMand>Value[tmpIndex] then Value[tmpIndex]:=tmpMand;
          dcaLow:   if tmpMand<Value[tmpIndex] then Value[tmpIndex]:=tmpMand;
          dcaAverage: begin
                        Value[tmpIndex]:=Value[tmpIndex]+tmpMand;
                        { trick: use the color as temporary count for average }
                        ASeries.ValueColor[tmpIndex]:=ASeries.ValueColor[tmpIndex]+1;
                      end;
        end;
      end
      else
      With DestSeries.ASeries do
      begin
        With ValuesList do
        for t:=2 to Count-1 do
            With TValueListAccess(ValueList[t]) do
            if Assigned(IData) then TempValue:=TField(IData).AsFloat
                               else TempValue:=0;

        if NotMandatoryValueList.ValueSource='' then
           if YManda then
              AddY(tmpMand,tmpXLabel,tmpColor)
           else
              AddX(tmpMand,tmpXLabel,tmpColor)
        else
           if YManda then
              AddXY(tmpNotMand,tmpMand,tmpXLabel,tmpColor)
           else
              AddXY(tmpMand,tmpNotMand,tmpXLabel,tmpColor);
      end;
    end;

    Function GetFieldValue(const AField:TField):Double;
    begin
      {$IFDEF LCL} // LCL does not support fkAggregate
      result:=AField.AsFloat;
      {$ELSE}
      With AField do
      if FieldKind=fkAggregate then result:=Value
                               else result:=AsFloat;
      {$ENDIF}
    end;

    Procedure AddSingleRecord;
    var t        : Integer;
        tmpName  : String;
        tmpField : TField;
    begin
      With tmpSeries do
      for t:=1 to NumFields do
      begin
        tmpName:=TeeExtractField(MandaList.ValueSource,t);
        if ASeries.XLabelsSource='' then tmpXLabel:=tmpName;

        if tmpName='' then
        begin
          tmpMand:=0;
          tmpColor:=clTeeColor;
        end
        else
        begin
          tmpField:=ADataSet.FieldByName(tmpName);
          tmpMand:=GetFieldValue(tmpField);

          // Should nullity be checked here or should be optional ?
          if tmpField.IsNull then
             tmpColor:=clNone
          else
             tmpColor:=clTeeColor;
        end;

        AddToSeries(tmpSeries);
      end;
    end;

    Function CalcXPos:String; { from DateTime to Label }
    var Year    : Word;
        Month   : Word;
        Day     : Word;
        Hour    : Word;
        Minute  : Word;
        Second  : Word;
        MSecond : Word;
        WeekNum : Word;
    begin
      result:='';
      DecodeDate(tmpNotMand,Year,Month,Day);
      Case tmpSeries.GroupPrefix of
       dgHour: begin
                 DecodeTime(tmpNotMand,Hour,Minute,Second,MSecond);
                 result:=FormatDateTime('dd hh:nn',Trunc(tmpNotMand)+Hour/24.0);
                 tmpNotMand := EncodeTime(Hour,0,0,0);
               end;
        dgDay: result:=FormatDateTime('dd/MMM',Trunc(tmpNotMand));
       dgWeek: Begin
                 WeekNum := DateToWeek(tmpNotMand,Year);
                 result:=TeeStr(WeekNum)+'/'+TeeStr(Year);
                 {$IFDEF D6}
                 tmpNotMand := EncodeDateWeek(Year,WeekNum,4);
                 {$ENDIF}
               end;
    dgWeekDay: Begin
                 result:={$IFDEF D15}FormatSettings.{$ENDIF}ShortDayNames[DayOfWeek(tmpNotMand)];
                 {$IFDEF D6}
                 DecodeDateWeek(tmpNotMand,Year,WeekNum,Day);
                 tmpNotMand := Day;
                 {$ENDIF}
               end;
      dgMonth: Begin
                  result:=FormatDateTime('MM/yy',EncodeDate(Year,Month,1));
                  tmpNotMand := EncodeDate(Year,Month,15);
               end;
    dgQuarter: Begin
                  result:=TeeStr(1+((Month-1) div 3))+'/'+TeeStr(Year);
                  tmpNotMand := EncodeDate(Year,((1+((Month-1) div 3)-1)*3)+2,1);
               end;
       dgYear: Begin
                  result:=FormatDateTime('yyyy',EncodeDate(Year,1,1));
                  tmpNotMand := EncodeDate(Year,6,15);
               end;
      end;
    end;

  var tmpData : TObject;
  Begin
    With tmpSeries do
    Begin
      if GroupPrefix=dgNone then
         if Assigned(LabelField) then
                                 {$IFDEF AXUNICODE}
                                 tmpXLabel:=Unicoding.CodeUTF8String(WideString(LabelField.AsVariant))
                                 {$ELSE}
                                 tmpXLabel:=LabelField.DisplayText
                                 {$ENDIF}
                                 else tmpXLabel:=''
      else
      begin
        tmpNotMand:=LabelField.AsFloat;
        tmpXLabel:=CalcXPos;
      end;

      if AggPrefix<>dcaNone then tmpColor:=clTeeColor
      else
      if Assigned(ColorField) then
         tmpColor:=ColorField.AsInteger
      else
      if (NumFields=1) and // Do not check for nullity in "Single Record" mode
         Assigned(MandaField) and MandaField.IsNull then
            tmpColor:=clNone
      else
         tmpColor:=clTeeColor;

      if NumFields=1 then
      begin
        if (not HasAnyDataSet) and (not Assigned(LabelField)) then
           tmpXLabel:=MandaList.ValueSource;

        tmpData:=TValueListAccess(ASeries.NotMandatoryValueList).IData;

        if Assigned(tmpData) then
           tmpNotMand:=TField(tmpData).AsFloat;
//           ADataSet.GetFieldData(TField(tmpData), @tmpNotMand)  // v7 speed opt.
        //else
        //   tmpNotMand:=0;

        if Assigned(MandaField) then tmpMand:=GetFieldValue(MandaField)
                                else tmpMand:=0;

        // add summary point
        AddToSeries(tmpSeries);
      end
      else AddSingleRecord
    end;
  end;

Var FListSeries : TDBChartSeriesList;

  Procedure FillTempSeriesList;

   Function GetDataSet(const ASeries:TChartSeries):TDataSet;
   begin
     With ASeries do
     if DataSource is TDataSet then result:=TDataSet(DataSource)
     else
     if DataSource is TDataSource then
        result:=TDataSource(DataSource).DataSet
     else
        result:=nil;
   end;

   Function IsDataSet(const ASeries:TChartSeries):Boolean;
   var tmp : TDataSet;
   begin
     tmp:=GetDataSet(ASeries);

     if Assigned(tmp) then
     begin
       result:=tmp=ADataSet;
       HasAnyDataSet:=ASeries.DataSource is TDataSet;
     end
     else result:=False;
   end;

   Procedure AddList(const tmpSeries:TChartSeries);
   var tmp : TDataSet;

      Function GetAField(Const FieldName:String):TField;
      begin
        if FieldName='' then result:=nil
                        else result:=tmp.FieldByName(FieldName);
      end;

      Function GetAFieldPrefix(St:String; Var Prefix:String):TField;
      begin
        Prefix:=TeeGetDBPart(1,St);
        if Prefix<>'' then St:=TeeGetDBPart(2,St);
        result:=GetAField(St);
      end;

   var t        : Integer;
       tmpAgg   : String;
       tmpGroup : String;
       tmpV     : TValueListAccess;
   begin
     SetLength(FListSeries,Length(FListSeries)+1);

     With FListSeries[Length(FListSeries)-1] do
     begin
       ASeries   :=tmpSeries;
       YManda    :=ASeries.YMandatory;
       MandaList :=ASeries.MandatoryValueList;
       NumFields :=TeeNumFields(MandaList.ValueSource);

       tmp:=GetDataSet(ASeries);

       if Assigned(tmp) then
       With ASeries do
       begin
         LabelField:=GetAFieldPrefix(XLabelsSource,tmpGroup);

         // try to find #SORTASC# or #SORTDESC# in label grouping
         LabelSort:=StrToDBOrder(tmpGroup);
         if LabelSort=loNone then
            GroupPrefix:=StrToDBGroup(tmpGroup) // find #HOUR# etc
         else
            GroupPrefix:=dgNone;

         ColorField:=GetAField(ColorSource);
         MandaField:=GetAFieldPrefix(TeeExtractField(MandaList.ValueSource,1),tmpAgg);

         if tmpAgg<>'' then
         begin
           tmpAgg:=UpperCase(tmpAgg);
           if tmpAgg='SUM'   then AggPrefix:=dcaSum else
           if tmpAgg='COUNT' then AggPrefix:=dcaCount else
           if tmpAgg='HIGH'  then AggPrefix:=dcaHigh else
           if tmpAgg='LOW'   then AggPrefix:=dcaLow else
           if tmpAgg='AVG'   then AggPrefix:=dcaAverage else
                                  AggPrefix:=dcaNone;
         end
         else
         begin
           AggPrefix:=dcaNone;

           for t:=0 to ValuesList.Count-1 do
           begin
             tmpV:=TValueListAccess(ValuesList[t]);

             if tmpV<>MandaList then
                tmpV.IData:=GetAField(tmpV.ValueSource);
           end;
         end;
       end;
     end;
   end;

  var t         : Integer;
      tmpSeries : TChartSeries;
  begin
    FListSeries:=nil;

    if Assigned(ASeries) then
    begin
      AddList(ASeries);
      HasAnyDataSet:=ASeries.DataSource=ADataSet;
    end
    else
    for t:=0 to SeriesCount-1 do
    Begin
      tmpSeries:=Series[t];
      if IsDataSet(tmpSeries) and
         (tmpSeries.MandatoryValueList.ValueSource<>'') then
            AddList(tmpSeries);
    end;
  end;

  Procedure TraverseDataSet;
  Var b : TBookMark;
      t : Integer;
      tt: Integer;
  begin
    With ADataSet do
    begin
      DisableControls;
      try
        b:=GetBookMark;
        try
          First;

          While not EOF do
          try
            if Assigned(FOnProcessRecord) then
               FOnProcessRecord(Self,ADataSet);

            for t:=0 to Length(FListSeries)-1 do
                if FListSeries[t].ASeries.DataSource=ADataSet then
                   ProcessRecord(FListSeries[t]);

            Next;
          except
            on EAbort do break; { <-- exit while loop !!! }
          end;

          for t:=0 to Length(FListSeries)-1 do
          With FListSeries[t] do
          begin
            if AggPrefix=dcaAverage then
            begin
              for tt:=0 to ASeries.Count-1 do
              begin
                MandaList.Value[tt]:=MandaList.Value[tt]/ASeries.ValueColor[tt];
                ASeries.ValueColor[tt]:=clTeeColor;
              end;
            end;

            if (AggPrefix<>dcaNone) and (LabelSort<>loNone) then
               ASeries.SortByLabels(LabelSort);
          end;
        finally
          try
            GotoBookMark(b);
          finally
            FreeBookMark(b);
          end;
        end;
      finally
        EnableControls;
      end;
    end;
  end;

Var OldCursor : TCursor;
    t         : Integer;
    OldPaint  : Boolean;
Begin
  if not IUpdating then
  With ADataSet do
  if Active then
  Begin
    IUpdating:=True;
    FListSeries:=nil;
    HasAnyDataSet:=False;

    try
      FillTempSeriesList;

      if Length(FListSeries)>0 then
      Begin
        {$IFDEF FMX}
        OldCursor:=crDefault;  // TODO
        {$ELSE}
        OldCursor:=Screen.Cursor;
        {$ENDIF}

        if FShowGlassCursor then
           TeeChangeCursor(nil, crHourGlass);

        OldPaint:=AutoRepaint;
        AutoRepaint:=False;
        try
          for t:=0 to Length(FListSeries)-1 do
              FListSeries[t].ASeries.Clear;

          if HasAnyDataSet then TraverseDataSet
          else
          begin
            {$IFDEF TEEOCX}
            ADataSet.Resync([]);
            {$ENDIF}

            if Assigned(FOnProcessRecord) then FOnProcessRecord(Self,ADataSet);
            for t:=0 to Length(FListSeries)-1 do
                if TDataSource(FListSeries[t].ASeries.DataSource).DataSet=ADataSet then
                begin
                  ProcessRecord(FListSeries[t]);
                end;
          end;

          for t:=0 to Length(FListSeries)-1 do
          begin
            FListSeries[t].ASeries.CheckOrder;
            FListSeries[t].ASeries.RefreshSeries;
          end;
        finally
          AutoRepaint:=OldPaint;
          Invalidate;

          if FShowGlassCursor then
             TeeChangeCursor(nil, OldCursor);
        end;
      end;
    finally
      FListSeries:=nil;
      IUpdating:=False;
    end;
  end;
end;

Procedure TCustomDBChart.RefreshData;
var t : Integer;
Begin
  for t:=0 to IDataSources.Count-1 do
      RefreshDataSet(IDataSources[t].DataSet,nil);
End;

Procedure FillDataSetFields(const DataSet:TDataSet; const Proc:TGetStrProc);
var t : Integer;
begin
  with DataSet do
  begin
    if FieldCount > 0 then
       for t:=0 to FieldCount-1 do Proc(Fields[t].FieldName)
    else
    Begin
      FieldDefs.Update;
      for t:=0 to FieldDefs.Count-1 do Proc(FieldDefs[t].Name);
    end;
  end;
end;

Procedure TCustomDBChart.FillSeriesSourceItems(ASeries:TChartSeries; Proc:TGetStrProc);
Begin
  With ASeries do
  if Assigned(DataSource) then
  begin
    if DataSource is TDataSource then
       FillDataSetFields(TDataSource(DataSource).DataSet,Proc)
    else
    if DataSource is TDataSet then
       FillDataSetFields(TDataSet(DataSource),Proc);
  end;
end;

Procedure TCustomDBChart.FillValueSourceItems(AValueList:TChartValueList; Proc:TGetStrProc);
Begin
  With AValueList.Owner do
  if Assigned(DataSource) then
  Begin
    if (DataSource is TDataSet) or (DataSource is TDataSource) then
       FillSeriesSourceItems(AValueList.Owner,Proc)
    else
       inherited;
  end;
end;

Procedure TCustomDBChart.Assign(Source:TPersistent);
begin
  if Source is TCustomDBChart then
  With TCustomDBChart(Source) do
  begin
    Self.AutoRefresh    :=AutoRefresh;
    Self.RefreshInterval:=RefreshInterval;
    Self.ShowGlassCursor:=ShowGlassCursor;
  end;
  inherited;
end;

Function DateToWeek(ADate:TDateTime; Var Year:Word):Integer;
const FirstWeekDay  = 2; // 2: Monday (ISO-8601)
      FirstWeekDate = 4; // 4: First four day-week (ISO-8601)
var Month : Word;
    Day   : Word;
begin
  ADate:=ADate-((DayOfWeek(ADate)-FirstWeekDay+7) mod 7)+ 7-FirstWeekDate;
  DecodeDate(ADate,Year,Month,Day);
  Result:=(Trunc(ADate-EncodeDate(Year,1,1)) div 7)+1;
end;

Function DateToWeekOld(Const ADate:TDateTime; Var Year:Word):Integer;
Const FirstDay=0; { Monday }
Var d,m,y,j,j0,j1,Week : Word;
begin
  DecodeDate(ADate,y,m,d);
  if (m < 3) then
    j := 1461*(y-1) div 4 + (153*(m+9)+2) div 5 + d
  else
    j := 1461*y div 4 + (153*(m-3)+2) div 5 + d;

  j0:=1461*(y-1) DIV 4 + 310;
  j0:=j0-(j0-FirstDay) MOD 7;

  If (j<j0) then
  begin
    j0 := 1461*(y-2) DIV 4 + 310;
    j0 := j0 - (j0-FirstDay) MOD 7;
    Week:=1 + (j-j0) DIV 7;
    Year:=y-1;
  end
  else
  begin
    j1 := 1461*y div 4 + 310;
    j1 := j1 - (j1-FirstDay) mod 7;
    if j<j1 then
    begin
      Week:=1 + (j-j0) div 7;
      Year:=y;
    end
    else
    begin
      Week:=1;
      Year:=y+1;
    end;
  end;
  result:=Week;
End;

Function TeeFieldType(AType:TFieldType):TTeeFieldType;
begin
  Case AType of
    ftAutoInc,
    ftCurrency,
    ftFloat,
    ftInteger,
    ftLargeInt,
    ftSmallint,
    ftWord,

    {$IFDEF D12}
    TFieldType.ftLongWord,
    TFieldType.ftShortint,
    TFieldType.ftByte,
    TFieldType.ftExtended,
    {$ENDIF}

    {$IFDEF D14}
    TFieldType.ftSingle,
    {$ENDIF}

    {$IFDEF D6}
    ftFMTBcd,
    {$ENDIF}

    ftBCD        : result:=tftNumber;

    ftDate,
    ftTime,

    {$IFDEF D7}
    ftTimeStamp,
    {$ENDIF}

    {$IFDEF D10}
    ftOraTimeStamp,
    {$ENDIF}

    ftDateTime   : result:=tftDateTime;

    ftString,
    ftFixedChar,

    ftMemo,
    ftFmtMemo,

    {$IFDEF D10}
    ftFixedWideChar,
    ftWideMemo,
    {$ENDIF}

    ftWideString : result:=tftText;
  else
    result:=tftNone;
  end;

  if Assigned(TeeOnGetFieldType) then
     TeeOnGetFieldType(AType,result);
end;

Function TeeGetDBPart(Num:Integer; St:String):String;
var i : Integer;
begin
  result:='';
  if Copy(St,1,1)='#' then
  begin
    Delete(St,1,1);
    i:=Pos('#',St);
    if i>0 then
       if Num=1 then result:=Copy(St,1,i-1)
       else
       if Num=2 then result:=Copy(St,i+1,Length(St)-i);
  end;
end;

Function StrToDBGroup(St:String):TTeeDBGroup;
begin
  St:=UpperCase(St);
  if St='HOUR' then result:=dgHour else
  if St='DAY' then result:=dgDay else
  if St='WEEK' then result:=dgWeek else
  if St='WEEKDAY' then result:=dgWeekDay else
  if St='MONTH' then result:=dgMonth else
  if St='QUARTER' then result:=dgQuarter else
  if St='YEAR' then result:=dgYear else
     result:=dgNone;
end;

Function StrToDBOrder(St:String):TChartListOrder;
begin
  St:=UpperCase(St);
  if St='SORTASC' then result:=loAscending
  else
  if St='SORTDES' then result:=loDescending
  else
     result:=loNone;
end;

{ TTeeSeriesDBSource }

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

class function TTeeSeriesDBSource.HasNew: Boolean;
begin
  result:=True;
end;

end.
