teestore.pas

Delphi TeeChartPro.6.01的源代码

  if Assigned(FSeries) then result:=FSeries.Count
  else
  begin
    result:=-1;
    for t:=0 to FChart.SeriesCount-1 do
    if (result=-1) or (FChart[t].Count>result) then
       result:=FChart[t].Count;
  end;
end;

function TSeriesData.PointToString(Index: Integer): String;
begin
  result:='';
end;

{ TSeriesDataText }
Constructor TSeriesDataText.Create(AChart:TCustomChart;
                         ASeries: TChartSeries=nil); { 5.01 }
begin
  inherited;
  FTextDelimiter:=TeeTabDelimiter;
end;

function TSeriesDataText.AsString: String;

  Function Header:String;

    Function HeaderSeries(ASeries:TChartSeries):String;

      Procedure AddToResult(const S:String);
      begin
        if result='' then result:=S
                     else result:=result+TextDelimiter+S;
      end;

    var t : Integer;
    begin
      result:='';
      With ASeries do
      begin
        if tfNoMandatory in IFormat then
           result:=NotMandatoryValueList.Name;

        if ValuesList.Count=2 then
           AddToResult(SeriesTitleOrName(ASeries))
        else
        begin
          AddToResult(MandatoryValueList.Name);
          for t:=2 to ValuesList.Count-1 do
              AddToResult(ValuesList[t].Name);
        end;
      end;
    end;

  var t : Integer;
  begin
    if IncludeIndex then result:=TeeMsg_Index
                    else result:='';

    if tfLabel in IFormat then
    begin
      if result<>'' then result:=result+TextDelimiter;
      result:=result+TeeMsg_Text;
    end;

    if tfColor in IFormat then
    begin
      if result<>'' then result:=result+TextDelimiter;
      result:=result+TeeMsg_Colors;
    end;

    if result<>'' then result:=result+TextDelimiter;

    if Assigned(Series) then result:=result+HeaderSeries(Series)
    else
    if Chart.SeriesCount>0 then
    begin
      result:=result+HeaderSeries(Chart[0]);
      for t:=1 to Chart.SeriesCount-1 do
          result:=result+TextDelimiter+HeaderSeries(Chart[t]);
    end;
  end;

Begin
  Prepare;
  if IncludeHeader then result:=Header+TeeTextLineSeparator
                   else result:='';
  result:=result+inherited AsString+TeeTextLineSeparator;
end;

function TSeriesDataText.PointToString(Index: Integer): String;

  Procedure Add(Const St:String);
  begin
    if result='' then result:=St
                 else result:=result+TextDelimiter+St;
  end;

var tmpNum : Integer;

  Procedure DoSeries(ASeries:TChartSeries);
  Var tt : Integer;
  begin
    { current number of exported Series }
    Inc(tmpNum);

    { the point Label text, if exists, and only for first Series }
    if (tmpNum=1) and (tfLabel in IFormat) then Add(ASeries.Labels[Index]);

    { the point Color,  if exists, and only for first Series }
    if (tmpNum=1) and (tfColor in IFormat) then Add(ColorToHex(ASeries.ValueColor[Index]));

    { the "X" point value, if exists }
    if tfNoMandatory in IFormat then
       Add(FloatToStr(ASeries.NotMandatoryValueList.Value[Index]));

    { the "Y" point value }
    Add(FloatToStr(ASeries.MandatoryValueList.Value[Index]));

    { write the rest of values (always) }
    for tt:=2 to ASeries.ValuesList.Count-1 do
        result:=result+TextDelimiter+FloatToStr(ASeries.ValuesList[tt].Value[Index]);
  end;

var t : Integer;
begin
  { Point number? }
  if IncludeIndex then Str(Index,result) else result:='';

  { Export Series data }
  tmpNum:=0;
  if Assigned(Series) then DoSeries(Series)
  else
  for t:=0 to Chart.SeriesCount-1 do DoSeries(Chart[t]);
end;

{ TSeriesDataXML }
constructor TSeriesDataXML.Create(AChart: TCustomChart;
  ASeries: TChartSeries);
begin
  inherited;
  FIncludeHeader:=True;
end;

Function TSeriesDataXML.AsString:String;

  Function SeriesPoints(ASeries:TChartSeries):String;

    Function GetPointString(Index:Integer):String;

      Procedure AddResult(Const St:String);
      begin
        if result='' then result:=St else result:=result+St;
      end;

      Function Get(AList:TChartValueList):String;
      begin
        with AList do
             result:=' '+Name+'="'+FloatToStr(Value[Index])+'"';
      end;

    var tt : Integer;
    begin
      if IncludeIndex then result:='index="'+TeeStr(Index)+'"'
                      else result:='';

      With ASeries do
      begin
        { the point Label text, if exists }
        if tfLabel in IFormat then result:=result+' text="'+Labels[Index]+'"';

        { the point Color, if exists }
        if tfColor in IFormat then
           result:=result+' color="'+ColorToHex(ValueColor[Index])+'"';

        { the "X" point value, if exists }
        if tfNoMandatory in IFormat then AddResult(Get(NotMandatoryValueList));

        { the "Y" point value }
        AddResult(Get(MandatoryValueList));

        { write the rest of values (always) }
        for tt:=2 to ValuesList.Count-1 do result:=result+Get(ValuesList[tt]);
      end;
    end;

  var t : Integer;
  begin
    result:='';
    if ASeries.Count>0 then
       for t:=0 to ASeries.Count-1 do
           result:=result+'<point '+GetPointString(t)+'/>'+TeeTextLineSeparator;
  end;

  Function XMLSeries(ASeries:TChartSeries):String;
  begin
    result:=
          '<series title="'+SeriesTitleOrName(ASeries)+'" type="'+
          GetGallerySeriesName(ASeries)+'" color="'+
          ColorToHex(ASeries.Color)+'">'+TeeTextLineSeparator+
          '<points count="'+TeeStr(ASeries.Count)+'">'+TeeTextLineSeparator+
          SeriesPoints(ASeries)+
          '</points>'+TeeTextLineSeparator+
          '</series>'+TeeTextLineSeparator+TeeTextLineSeparator;
  end;

var t : Integer;
begin
  Prepare; { 5.02 }
  if IncludeHeader then
     result:='<?xml version="1.0" encoding="ISO-8859-1"?>'+TeeTextLineSeparator
  else
     result:='';

  if Assigned(FSeries) then result:=result+XMLSeries(FSeries)
  else
  begin
    result:=result+'<chart>'+TeeTextLineSeparator;
    for t:=0 to FChart.SeriesCount-1 do result:=result+XMLSeries(FChart[t]);
    result:=result+'</chart>';
  end;
end;

{ TSeriesDataHTML }
function TSeriesDataHTML.AsString: String;

  Function Header:String;

    Function HeaderSeries(ASeries:TChartSeries):String;

      Procedure AddCol(Const ColTitle:String);
      begin
        result:=result+'<td>'+ColTitle+'</td>'
      end;

    var t : Integer;
    begin
      result:='';
      if tfLabel in IFormat then AddCol(TeeMsg_Text);
      if tfColor in IFormat then AddCol(TeeMsg_Colors);

      With ASeries do
      begin
        if tfNoMandatory in IFormat then AddCol(NotMandatoryValueList.Name);

        if ValuesList.Count=2 then AddCol(SeriesTitleOrName(ASeries))
        else
        begin
          AddCol(MandatoryValueList.Name);
          for t:=2 to ValuesList.Count-1 do AddCol(ValuesList[t].Name);
        end;
      end;
    end;

  var t : Integer;
  begin
    result:='<tr>';
    if IncludeIndex then result:=result+'<td>'+TeeMsg_Index+'</td>';

    if Assigned(FSeries) then result:=result+HeaderSeries(FSeries)
    else
    for t:=0 to FChart.SeriesCount-1 do result:=result+HeaderSeries(FChart[t]);

    result:=result+'</tr>';
  end;

begin
  Prepare;
  result:='<table border="1">'+TeeTextLineSeparator;
  if IncludeHeader then result:=result+Header+TeeTextLineSeparator;
  result:=result+inherited AsString+TeeTextLineSeparator+'</table>';
end;

Function TSeriesDataHTML.PointToString(Index:Integer):String;

  Function GetPointString:String;

    Function GetPointStringSeries(ASeries:TChartSeries):String;

      Function CellDouble(Const Value:Double):String;
      begin
        result:='<td>'+FloatToStr(Value)+'</td>';
      end;

    Const EmptyCell='<td></td>';
    Var tt : Integer;
    begin
      result:='';
      With ASeries do
      if (Count-1)<Index then
      begin
        if tfLabel in IFormat then result:=result+EmptyCell;
        if tfColor in IFormat then result:=result+EmptyCell;
        if tfNoMandatory in IFormat then result:=result+EmptyCell;

        result:=result+EmptyCell;
        for tt:=2 to ValuesList.Count-1 do result:=result+EmptyCell;
      end
      else
      begin
        { the point Label text, if exists }
        if tfLabel in IFormat then result:=result+'<td>'+Labels[Index]+'</td>';

        { the point Label text, if exists }
        if tfColor in IFormat then
           result:=result+'<td>'+ColorToHex(ValueColor[Index])+'</td>';

        { the "X" point value, if exists }
        if tfNoMandatory in IFormat then
           result:=result+CellDouble(NotMandatoryValueList.Value[Index]);

        { the "Y" point value }
        result:=result+CellDouble(MandatoryValueList.Value[Index]);

        { write the rest of values (always) }
        for tt:=2 to ValuesList.Count-1 do
            result:=result+CellDouble(ValuesList[tt].Value[Index]);
      end;
    end;

  var t : Integer;
  begin
    if IncludeIndex then result:='<td>'+TeeStr(Index)+'</td>'
                    else result:='';

    if Assigned(FSeries) then result:=result+GetPointStringSeries(FSeries)
    else
    for t:=0 to FChart.SeriesCount-1 do
        result:=result+GetPointStringSeries(FChart[t])
  end;

begin
  result:='<tr>'+GetPointString+'</tr>';
end;

{ TSeriesDataXLS }
Procedure TSeriesDataXLS.SaveToStream(AStream:TStream);
var Buf : Array[0..4] of Word;
    Row : Integer;
    Col : Integer;

  Procedure WriteBuf(Value,Size:Word);
  begin
    Buf[0]:=Value;
    Buf[1]:=Size;
    AStream.Write(Buf,2*SizeOf(Word));
  end;

  Procedure WriteParams(Value,Size:Word);
  Const Attr:Array[0..2] of Byte=(0,0,0);
  begin
    WriteBuf(Value,Size+2*SizeOf(Word)+SizeOf(Attr));
    if IncludeHeader then WriteBuf(Row+1,Col)
                     else WriteBuf(Row,Col);
    AStream.Write(Attr,SizeOf(Attr));
  end;

  procedure WriteDouble(Const Value:Double);
  begin
    WriteParams(3,SizeOf(Double));
    AStream.WriteBuffer(Value,SizeOf(Double));
  end;

  procedure WriteText(Const Value:ShortString);
  begin
    WriteParams(4,Length(Value)+1);
    AStream.Write(Value,Length(Value)+1)
  end;

  procedure WriteNull;
  begin
    WriteParams(1,0);
  end;

  Procedure WriteHeaderSeries(ASeries:TChartSeries);
  var tt : Integer;
  begin
    if tfLabel in IFormat then
    begin
      WriteText(TeeMsg_Text);
      Inc(Col);
    end;

    if tfColor in IFormat then
    begin
      WriteText(TeeMsg_Colors);
      Inc(Col);
    end;

    if tfNoMandatory in IFormat then
    begin
      WriteText(ASeries.NotMandatoryValueList.Name);
      Inc(Col);
    end;

    for tt:=1 to ASeries.ValuesList.Count-1 do
    begin
      WriteText(ASeries.ValuesList[tt].Name);
      Inc(Col);
    end;
  end;

  Procedure WriteSeries(ASeries:TChartSeries);
  var tt : Integer;
  begin
    if (ASeries.Count-1)<Row then
    begin
      if tfLabel in IFormat then
      begin
        WriteText('');
        Inc(Col);
      end;

      if tfColor in IFormat then
      begin
        WriteText('');
        Inc(Col);
      end;

      if tfNoMandatory in IFormat then
      begin
        WriteNull;
        Inc(Col);
      end;

      for tt:=1 to ASeries.ValuesList.Count-1 do
      begin
        WriteNull;
        Inc(Col);
      end;
    end
    else
    begin
      if tfLabel in IFormat then
      begin
        WriteText(ASeries.Labels[Row]);
        Inc(Col);
      end;

      if tfColor in IFormat then
      begin
        WriteText(ColorToHex(ASeries.ValueColor[Row]));
        Inc(Col);
      end;

      if tfNoMandatory in IFormat then
      begin
        WriteDouble(ASeries.NotMandatoryValueList.Value[Row]);
        Inc(Col);
      end;

      if ASeries.IsNull(Row) then
      for tt:=1 to ASeries.ValuesList.Count-1 do
      begin
        WriteNull;
        Inc(Col);
      end
      else
      begin
        WriteDouble(ASeries.MandatoryValueList.Value[Row]);
        Inc(Col);
        for tt:=2 to ASeries.ValuesList.Count-1 do
        begin
          WriteDouble(ASeries.ValuesList[tt].Value[Row]);
          Inc(Col);
        end;
      end;
    end;
  end;

Const BeginExcel : Array[0..5] of Word=($809,8,0,$10,0,0);
      EndExcel   : Array[0..1] of Word=($A,0);
Var tt  : Integer;
    tmp : Integer;
begin
  Prepare;
  AStream.WriteBuffer(BeginExcel,SizeOf(BeginExcel)); { begin and BIF v5 }

  WriteBuf($0200,5*SizeOf(Word));  { row x col }

  Buf[0]:=0;
  Buf[2]:=0;
  Buf[3]:=0; { columns }
  Buf[4]:=0;

  Buf[1]:=MaxSeriesCount; { rows }
  if IncludeHeader then Inc(Buf[1]);

  if IncludeIndex then Inc(Buf[3]);
  if Assigned(FSeries) then tmp:=1
                       else tmp:=FChart.SeriesCount;
  if tfLabel in IFormat then Inc(Buf[3],tmp);
  if tfColor in IFormat then Inc(Buf[3],tmp);
  if tfNoMandatory in IFormat then Inc(Buf[3],tmp);

  if Assigned(FSeries) then
     Inc(Buf[3],FSeries.ValuesList.Count-1)
  else
  for Row:=0 to FChart.SeriesCount-1 do
     Inc(Buf[3],FChart[Row].ValuesList.Count-1);

  AStream.Write(Buf,5*SizeOf(Word));

  if IncludeHeader then
  begin
    Row:=-1;
    Col:=0;
    if IncludeIndex then
    begin
      WriteText(TeeMsg_Index);
      Inc(Col);
    end;
    if Assigned(FSeries) then WriteHeaderSeries(FSeries)
    else
    for tt:=0 to FChart.SeriesCount-1 do WriteHeaderSeries(FChart[tt]);
  end;

  for Row:=0 to MaxSeriesCount-1 do
  begin
    Col:=0;
    if IncludeIndex then
    begin
      WriteDouble(Row);
      Inc(Col);
    end;

    if Assigned(FSeries) then WriteSeries(FSeries)
    else
    for tt:=0 to FChart.SeriesCount-1 do WriteSeries(FChart[tt]);
  end;

  AStream.WriteBuffer(EndExcel,SizeOf(EndExcel)); { end }
end;

{$IFNDEF TEEOCX}
type TChartChart=class(TChart) end;
     TODBCChart=class(TChartChart) end;
initialization
  RegisterClasses([TChartChart,TODBCChart]);
{$ENDIF}
end.