teexml.pas

TeeChart7Source 控件

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

interface

uses
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes,
  {$IFDEF CLX}
  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QButtons, QExtCtrls,
  {$ELSE}
  Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
  {$ENDIF}
  {$IFDEF CLR}
  System.XML,
  {$ENDIF}
  TeEngine, TeeURL, Chart, Series, TeeSourceEdit, TeCanvas;

type
  {$IFNDEF CLR}
  XmlDocument=OleVariant;
  XmlNode=OleVariant;
  XmlNodeList=XmlNode;
  XmlAttributeCollection=XmlNode;
  {$ENDIF}

  TTeeXMLSource=class(TTeeSeriesSourceFile)
  private
    FChart       : TCustomChart;
    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 XMLError(Const Reason:String);
    procedure SetChart(const Value: TCustomChart);
    procedure SetXML(const Value: TStrings);
  protected
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    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 XMLDocument:XmlDocument read FXMLDocument;
  published
    property Active;
    property Chart:TCustomChart read FChart write SetChart;
    property FileName;
    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)
    Label1: TLabel;
    EFile: TEdit;
    OpenDialog1: TOpenDialog;
    SpeedButton1: TSpeedButton;
    Label2: TLabel;
    CBSeries: TComboFlat;
    Label3: TLabel;
    ESource: TEdit;
    CBActive: TCheckBox;
    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 FormDestroy(Sender: TObject);
    procedure ESourceChange(Sender: TObject);
    procedure CBActiveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    DataSource : TTeeXMLSource;
    Procedure FillXMLSeries;
  public
    { Public declarations }
  end;

implementation

{$IFNDEF CLX}
{$R *.DFM}
{$ELSE}
{$R *.xfm}
{$ENDIF}

uses {$IFNDEF LINUX}
     ComObj,
     {$ENDIF}
     {$IFDEF D6}
     Variants,
     {$ENDIF}
     TeeProcs, TeeProCo;

{$IFDEF CLR}
function VarIsClear(const V: XmlNode): Boolean; overload;
begin
  result:=not Assigned(V);
end;

function VarIsClear(const V: XmlNodeList): Boolean; overload;
begin
  result:=not Assigned(V);
end;

function VarIsClear(const V: XmlAttributeCollection): Boolean; overload;
begin
  result:=not Assigned(V);
end;

type
  XmlNodeHelper=class helper for XmlNode
  public
    function NodeValue:String;
  end;

  XmlNodeListHelper=class helper for XmlNodeList
  public
    function Length:Integer;
  end;

function XmlNodeHelper.NodeValue:String;
begin
  result:=Value;
end;

function XmlNodeListHelper.Length:Integer;
begin
  result:=Count;
end;

{$ELSE}
{$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}
{$ENDIF}

{ TTeeXMLSource }

procedure TTeeXMLSource.CloseXML;
begin
  {$IFDEF CLR}
  FreeAndNil(FXMLDocument);
  {$ELSE}
  if not VarIsEmpty(FXMLDocument) then
     FXMLDocument:=UnAssigned;
  {$ENDIF}
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 tmpSeries.Clear
  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{$IFNDEF CLR}^{$ENDIF})=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;

  {$IFDEF CLR}
  tmpPoints:=ANode.SelectNodes('//points');
  {$ELSE}
  tmpPoints:=ANode.getElementsByTagName('points');
  {$ENDIF}

  if not VarIsClear(tmpPoints) then
  begin
    {$IFDEF CLR}
    tmpPoint:=tmpPoints[0].SelectNodes('//point');
    {$ELSE}
    tmpPoint:=tmpPoints.Item[0].getElementsByTagName('point');
    {$ENDIF}

    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{$IFNDEF CLR}.Item{$ENDIF}[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:=''
                                 else tmpTex:=tmpText.NodeValue;

          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