{********************************************}
{   TeeChart XML DataSource                  }
{ Copyright (c) 2001-2020 by Steema Software }
{        All Rights Reserved                 }
{********************************************}
unit TeeXML;
{$I TeeDefs.inc}

interface

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

  {$IFDEF D9}
  Types,
  {$ENDIF}
  
  Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls,

  TeEngine, TeeURL, Chart, Series, TeeSourceEdit, TeCanvas, TeeProcs;

type
  {$IFDEF LCL}
  OleVariant=Variant;
  {$ENDIF}

  XmlDocument=OleVariant;
  XmlNode=OleVariant;
  XmlNodeList=XmlNode;
  XmlAttributeCollection=XmlNode;

  {$IFDEF D16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  {$ENDIF}
  TTeeXMLSource=class(TTeeSeriesSourceFile)
  private
    FSeriesNode  : String;
    FValueSource : String;
    FXML         : TStrings;
    FXMLDocument : XmlDocument;

    Function CreateAndLoadXML:XmlDocument;
    procedure CloseXML;
    Procedure FillSeries(AItems:TStrings);
    procedure LoadSeriesNode(ANode:XmlNode);
    procedure SetSeriesNode(const Value: String);
    procedure SetValueSource(const Value: String);
    procedure SetXML(const Value: TStrings);
    procedure XMLError(Const Reason:String);
  protected
    procedure SetActive(const Value: Boolean); override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Close; override;
    class Function Description:String; override;
    class Function Editor:TComponentClass; override;
    Procedure Load; override;

    property XMLDoc:XmlDocument read FXMLDocument;
  published
    property Active;
    property Chart;
    property FileName;
    property LoadMode;
    property Series;
    property SeriesNode:String read FSeriesNode write SetSeriesNode;
    property ValueSource:String read FValueSource write SetValueSource;
    property XML:TStrings read FXML write SetXML;
  end;

  TXMLSourceEditor = class(TBaseSourceEditor)
    OpenDialog1: TOpenDialog;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    CBSeries: TComboFlat;
    ESource: TEdit;
    CBActive: TCheckBox;
    CBLoadMode: TComboFlat;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    EFile: TEdit;
    RBFile: TRadioButton;
    RBManual: TRadioButton;
    Memo1: TMemo;
    Button1: TButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure EFileChange(Sender: TObject);
    procedure CBSeriesDropDown(Sender: TObject);
    procedure CBSeriesChange(Sender: TObject);
    procedure BApplyClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ESourceChange(Sender: TObject);
    procedure CBActiveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CBLoadModeChange(Sender: TObject);
    procedure RBManualClick(Sender: TObject);
    procedure RBFileClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Memo1Enter(Sender: TObject);
    procedure EFileEnter(Sender: TObject);
  private
    { Private declarations }
    procedure EnableApply;
    Procedure FillXMLSeries;
  public
    { Public declarations }
  end;

implementation

{$IFNDEF LCL}
{$R *.DFM}
{$ELSE}
{$R *.lfm}
{$ENDIF}

uses {$IFNDEF LINUX}
     ComObj,
     {$ENDIF}
     {$IFDEF D6}
     Variants,
     {$ELSE}
     {$IFDEF LCL}
     Variants,
     {$ENDIF}
     {$ENDIF}
     TeeProCo, TeePenDlg, TeeStringsEditor
     {$IFDEF AXUNICODE}
     ,TeeUnicode
     {$ENDIF}
     ;

{$IFNDEF D6}
function VarIsClear(const V: Variant): Boolean;
begin
  with TVarData(V) do
       result := (VType = varEmpty) or
                 (((VType = varDispatch) or (VType = varUnknown)) and
                  (VDispatch = nil))
end;
{$ENDIF}

{ TTeeXMLSource }

procedure TTeeXMLSource.CloseXML;
begin
  if not VarIsEmpty(FXMLDocument) then
     FXMLDocument:=UnAssigned;
end;

procedure TTeeXMLSource.Close;
begin
  CloseXML;
  inherited;
end;

class function TTeeXMLSource.Description: String;
begin
  result:=TeeMsg_XMLFile;
end;

class function TTeeXMLSource.Editor: TComponentClass;
begin
  result:=TXMLSourceEditor;
end;

procedure TTeeXMLSource.XMLError(Const Reason:String);
Const TeeMsg_WrongXMLFormat='TeeChart XML: %s';
begin
  raise ChartException.CreateFmt(TeeMsg_WrongXMLFormat,[Reason]);
end;

procedure TTeeXMLSource.LoadSeriesNode(ANode:XmlNode);

  Function HexToColor(S:String):TColor;
  begin
    S:=Trim(S);
    if Copy(s,1,1)='#' then
    begin
      result:=RGB(StrToInt('$'+Copy(s,2,2)),
                  StrToInt('$'+Copy(s,4,2)),
                  StrToInt('$'+Copy(s,6,2)));
    end
    else result:=clTeeColor;
  end;

var tmpPoints : XmlNodeList;
    tmpPoint  : XmlNodeList;
    t         : Integer;
    tt        : Integer;
    tmpValue  : XmlNode;
    tmpValueX : XmlNode;
    tmpText   : XmlNode;
    tmpItem   : XmlNode;
    tmpPointItem : XmlAttributeCollection;
    tmpColor  : XmlNode;
    tmpName   : String;
    tmpX      : String;
    tmpTex    : String;
    tmpList   : String;
    tmpCol    : TColor;
    tmpSeries : TChartSeries;
    tmpClass  : TChartSeriesClass;
begin
  tmpSeries:=Series;

  if Assigned(tmpSeries) then
  begin
    if LoadMode=lmClear then
       tmpSeries.Clear;
  end
  else
  begin
    // Create a new Series...

    tmpClass:=nil;
    tmpItem:=ANode.Attributes.GetNamedItem('type');

    if not VarIsClear(tmpItem) then
    begin
      tmpName:=UpperCase(tmpItem.NodeValue);

      With TeeSeriesTypes do
      for t:=0 to Count-1 do
         if (Items[t].FunctionClass=nil) and
            (UpperCase(Items[t].Description^)=UpperCase(tmpName)) then
         begin
           tmpClass:=Items[t].SeriesClass;
           break;
         end;
    end;

    if not Assigned(tmpClass) then tmpClass:=TBarSeries;

    tmpSeries:=Chart.AddSeries(tmpClass.Create(Self.Owner));

    // Series Title
    tmpItem:=ANode.Attributes.GetNamedItem('title');
    if not VarIsClear(tmpItem) then
       tmpSeries.Title:=tmpItem.NodeValue;

    // Series Color
    tmpColor:=ANode.Attributes.GetNamedItem('color');
    if not VarIsClear(tmpColor) then
       tmpSeries.Color:=HexToColor(tmpColor.NodeValue);
  end;

  tmpPoints:=ANode.getElementsByTagName('points');

  if not VarIsClear(tmpPoints) then
  begin
    tmpPoint:=tmpPoints.Item[0].getElementsByTagName('point');

    if VarIsClear(tmpPoint) then XMLError('No <point> nodes.')
    else
    begin
      tmpName:=tmpSeries.MandatoryValueList.ValueSource;
      if tmpName='' then tmpName:=Self.ValueSource;
      if tmpName='' then
         tmpName:=tmpSeries.MandatoryValueList.Name;

      tmpX:=tmpSeries.NotMandatoryValueList.ValueSource;
      if tmpX='' then
         tmpX:=tmpSeries.NotMandatoryValueList.Name;

      for t:=0 to tmpPoint.Length-1 do
      begin
        tmpPointItem:=tmpPoint.Item[t].Attributes;

        if VarIsClear(tmpPointItem) then
        begin
          XMLError('<point> node has no data.');
          break;
        end
        else
        begin
          tmpText:=tmpPointItem.GetNamedItem('text');

          if VarIsClear(tmpText) then tmpTex:=''
                       {$IFDEF AXUNICODE}
                       else tmpTex:=Unicoding.CodeUTF8String(tmpText.NodeValue);
                       {$ELSE}
                       else tmpTex:=tmpText.NodeValue;
                       {$ENDIF}

          tmpColor:=tmpPointItem.GetNamedItem('color');

          if VarIsClear(tmpColor) then tmpCol:=clTeeColor
                                  else tmpCol:=HexToColor(tmpColor.NodeValue);

          // Rest of values (if exist)
          for tt:=2 to tmpSeries.ValuesList.Count-1 do
          begin
            tmpList:=tmpSeries.ValuesList[tt].ValueSource;
            if tmpList='' then tmpList:=tmpSeries.ValuesList[tt].Name;

            tmpValue:=tmpPointItem.GetNamedItem(tmpList);

            if not VarIsClear(tmpValue) then
               tmpSeries.ValuesList[tt].TempValue:=tmpValue.NodeValue;
          end;

          // Get X and Y values
          if tmpName='' then VarClear(tmpValue)
                        else tmpValue:=tmpPointItem.GetNamedItem(tmpName);

          if tmpX='' then VarClear(tmpValueX)
                     else tmpValueX:=tmpPointItem.GetNamedItem(tmpX);

          // Add point !

          if VarIsClear(tmpValue) then
             if VarIsClear(tmpValueX) then
                tmpSeries.AddNull(tmpTex)
             else
                tmpSeries.AddNullXY(tmpValueX.NodeValue,0,tmpTex)
          else
          if VarIsClear(tmpValueX) then
             tmpSeries.Add(tmpValue.NodeValue,tmpTex,tmpCol)
          else
             tmpSeries.AddXY(tmpValueX.NodeValue,tmpValue.NodeValue,tmpTex,tmpCol)
        end;
      end;
    end;
  end
  else XMLError('No <points> node.');
end;

Function TTeeXMLSource.CreateAndLoadXML:XmlDocument;
begin
  {$IFDEF LINUX}
  result:=0;
  {$ELSE}

  result:=CreateOleObject('MSXML.DomDocument');
  result.Async:=False;

  if FXML.Count>0 then
     result.LoadXML(FXML.Text)
  else
  if FileName<>'' then
     if not result.Load(FileName) then
        XMLError('Cannot load '+FileName);

  {$ENDIF}
end;

procedure TTeeXMLSource.Load;
var tmpSeries : XmlNodeList;
    t         : Integer;
    tmp       : String;
    tmpTitle  : XmlNode;
    tmpFound  : Boolean;
begin
  if not (csDesigning in ComponentState) then
  if Assigned(Series) or Assigned(Chart) then
  if (FileName<>'') or (XML.Count>0) then
  begin
    CloseXML;
    FXMLDocument:=CreateAndLoadXML;
    tmpSeries:=FXMLDocument.getElementsByTagName('series');

    if VarIsClear(tmpSeries) then
       XMLError('No <series> nodes.')
    else
    begin
      if not Assigned(Series) then
         Chart.FreeAllSeries;

      if SeriesNode='' then
      begin
        if tmpSeries.Length>0 then
        for t:=0 to tmpSeries.Length-1 do
        begin
          LoadSeriesNode(tmpSeries.Item[t]);

          if Assigned(Series) then
             break;
        end
        else
           XMLError('Empty <series> node.');
      end
      else
      begin
        tmpFound:=False;

        for t:=0 to tmpSeries.Length-1 do
        begin
          tmpTitle:=tmpSeries.Item[t].Attributes.GetNamedItem('title');

          if not VarIsClear(tmpTitle) then
          begin
            tmp:=tmpTitle.NodeValue;

            if UpperCase(tmp)=UpperCase(SeriesNode) then
            begin
              LoadSeriesNode(tmpSeries.Item[t]);
              tmpFound:=True;
              break;
            end;
          end;
        end;

        if not tmpFound then
           XMLError('Series '+SeriesNode+' not found');
      end;
    end;
  end;
end;

Procedure TTeeXMLSource.FillSeries(AItems:TStrings);
var t         : Integer;
    tmpSeries : XmlNodeList;
    tmpXML    : {$IFDEF D16}
                  {$IFDEF FMX}
                  FMXTee.TeeXML.XmlDocument
                  {$ELSE}
                  XmlDocument
                  {$ENDIF}
                {$ELSE}
                TeeXML.XmlDocument
                {$ENDIF}
                ;
    tmpNode   : XmlNode;
begin
  tmpXML:=CreateAndLoadXML;
  try
    AItems.Clear;
    tmpSeries:=tmpXML.getElementsByTagName('series');

    if not VarIsClear(tmpSeries) then
       for t:=0 to tmpSeries.Length-1 do
       begin
         tmpNode:=tmpSeries.Item[t].Attributes.GetNamedItem('title');

         if not VarIsClear(tmpNode) then
            AItems.Add(tmpNode.NodeValue);
       end;
  finally
    tmpXML:=UnAssigned;
  end;
end;

procedure TTeeXMLSource.SetSeriesNode(const Value: String);
begin
  if FSeriesNode<>Value then
  begin
    Close;
    FSeriesNode:=Value;
  end;
end;

procedure TTeeXMLSource.SetValueSource(const Value: String);
begin
  if FValueSource<>Value then
  begin
    Close;
    FValueSource:=Value;
  end;
end;

constructor TTeeXMLSource.Create(AOwner: TComponent);
begin
  inherited;
  FXML:=TStringList.Create;
end;

destructor TTeeXMLSource.Destroy;
begin
  FXML.Free;
  inherited;
end;

procedure TTeeXMLSource.SetXML(const Value: TStrings);
begin
  FXML.Assign(Value);
end;

procedure TTeeXMLSource.SetActive(const Value: Boolean);
begin
  if Value<>Active then
  begin
    inherited;

    if Active and (not Assigned(Series)) and (FileName<>'') then
       if not (csLoading in ComponentState) then Load;
  end;
end;

{ TXMLSourceEditor }
procedure TXMLSourceEditor.SpeedButton1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
     EFile.Text:=OpenDialog1.FileName;
end;

procedure TXMLSourceEditor.EnableApply;
begin
  BApply.Enabled:=True;
end;

procedure TXMLSourceEditor.EFileChange(Sender: TObject);
begin
  EFileEnter(Self);
  CBSeries.Clear;
  EnableApply;
end;

procedure TXMLSourceEditor.CBSeriesDropDown(Sender: TObject);
begin
  if CBSeries.Items.Count=0 then
     FillXMLSeries;
end;

Procedure TXMLSourceEditor.FillXMLSeries;
begin
  Screen.Cursor:=crHourGlass;
  try
    if (EFile.Text<>'') or (Memo1.Lines.Count>0) then
    with TTeeXMLSource.Create(nil) do
    try
      FileName:=EFile.Text;
      XML:=Memo1.Lines;

      FillSeries(CBSeries.Items);
    finally
      Free;
    end
    else
    if Assigned(IDataSource) and (TTeeXMLSource(IDataSource).XML.Count>0) then
       TTeeXMLSource(IDataSource).FillSeries(CBSeries.Items);
  finally
    Screen.Cursor:=crDefault;
  end;
end;

procedure TXMLSourceEditor.CBSeriesChange(Sender: TObject);
begin
  EnableApply;
end;

procedure TXMLSourceEditor.BApplyClick(Sender: TObject);
begin
  inherited;

  CheckReplaceSource(IDataSource);

  with TTeeXMLSource(IDataSource) do
  begin
    FileName:=EFile.Text;
    XML:=Memo1.Lines;
    SeriesNode:=CBSeries.CurrentItem;
    ValueSource:=ESource.Text;
  end;

  BApply.Enabled:=False;

  if CBLoadMode.ItemIndex=0 then
     IDataSource.LoadMode:=lmClear
  else
     IDataSource.LoadMode:=lmAppend;

  IDataSource.Close;

  if (TTeeXMLSource(IDataSource).FileName<>'') or
     (TTeeXMLSource(IDataSource).XML.Count>0) then
     IDataSource.Open;
end;

procedure TXMLSourceEditor.FormShow(Sender: TObject);
begin
  inherited;

  LLabel.Visible:=False;
  CBSources.Visible:=False;

  CheckDataSource(TTeeXMLSource);

  with TTeeXMLSource(IDataSource) do
  begin
    EFile.Text:=FileName;
    Memo1.Lines:=XML;

    FillXMLSeries;

    if SeriesNode<>'' then
       with CBSeries do ItemIndex:=Items.IndexOf(SeriesNode);

    ESource.Text:=ValueSource;
    CBActive.Checked:=Active;

    if LoadMode=lmClear then
       CBLoadMode.ItemIndex:=0
    else
       CBLoadMode.ItemIndex:=1;
  end;

  if Memo1.Lines.Count>0 then
     RBManual.Checked:=True
  else
     RBFile.Checked:=True;

  BApply.Enabled:=Assigned(TheSeries) and (IDataSource<>TheSeries.DataSource);
end;

procedure TXMLSourceEditor.ESourceChange(Sender: TObject);
begin
  EnableApply;
end;

procedure TXMLSourceEditor.CBActiveClick(Sender: TObject);
begin
  if Assigned(IDataSource) then
     IDataSource.Active:=CBActive.Checked;
end;

procedure TXMLSourceEditor.FormCreate(Sender: TObject);
begin
  inherited;

  OpenDialog1.Filter:=TeeMsg_XMLFile+'|*.xml';

  {$IFDEF D6}
  SpeedButton1.HelpContext:=1865;
  {$ENDIF}
end;

procedure TXMLSourceEditor.CBLoadModeChange(Sender: TObject);
begin
  EnableApply;
end;

procedure TXMLSourceEditor.RBManualClick(Sender: TObject);
begin
  RBFile.Checked:=False;
  Memo1.SetFocus;
end;

procedure TXMLSourceEditor.RBFileClick(Sender: TObject);
begin
  RBManual.Checked:=False;
  EFile.SetFocus;
end;

procedure TXMLSourceEditor.Button1Click(Sender: TObject);
begin
  if TeeEditStrings(Self,Memo1.Lines) then
  begin
    EnableApply;
    Memo1Enter(Self);
    Memo1.SetFocus;
  end;
end;

procedure TXMLSourceEditor.Memo1Change(Sender: TObject);
begin
  EnableApply;
end;

procedure TXMLSourceEditor.Memo1Enter(Sender: TObject);
begin
  RBFile.Checked:=False;
  RBManual.Checked:=True;
end;

procedure TXMLSourceEditor.EFileEnter(Sender: TObject);
begin
  RBFile.Checked:=True;
  RBManual.Checked:=False;
end;

initialization
  TeeActivateGroup;
  RegisterClass(TTeeXMLSource);
  RegisterClass(TXMLSourceEditor);
  TeeSources.Add(TTeeXMLSource);
finalization
  TeeActivateGroup;
  TeeSources.Remove(TTeeXMLSource);
  UnRegisterClass(TXMLSourceEditor);
  UnRegisterClass(TTeeXMLSource);
end.
