teestore.pas

BCB第三方组件

{
Procedure WriteChartData(AStream:TStream; AChart:TCustomChart);
Var t : Integer;
begin
  for t:=0 to AChart.SeriesCount-1 do TSeriesAccess(AChart[t]).WriteData(AStream);
end;
}

{$IFDEF D5}
type
  {$IFDEF CLR}
  TWriterAccess=class(TWriter)
  protected
    procedure DoSetRoot(Value: TComponent);
  end;

procedure TWriterAccess.DoSetRoot(Value: TComponent);
begin
  SetRoot(Value);
end;

  {$ELSE}
  TWriterAccess=class(TWriter);
  {$ENDIF}

{$ENDIF}

Procedure SaveChartToStream(AChart:TCustomChart; AStream:TStream;
                            IncludeData:Boolean=True;
                            TextFormat:Boolean=False);
var tmp      : TCustomChart;
    OldName  : TComponentName;
    {$IFDEF D5}
    Writer   : {$IFDEF CLR}TWriterAccess{$ELSE}TWriter{$ENDIF};
    tmpOwner : TComponent;
    {$ENDIF}
    DestStream : TStream;
    t          : Integer;
    tmpSeries  : TChartSeries;
begin
  DestStream:=AStream;

  if TextFormat then AStream:=TMemoryStream.Create;

  try
    TeeWriteHeader(AStream);

    { write the Chart, Series and Tools properties }
    tmp:=AChart;
    if not (csDesigning in AChart.ComponentState) then
    begin
      OldName:=AChart.Name;
      AChart.Name:='';
    end;

    for t:=0 to AChart.SeriesCount-1 do
    begin
      tmpSeries:=AChart[t];
      if IncludeData then
          TSeriesAccess(tmpSeries).ForceSaveData:=True
      else
          TSeriesAccess(tmpSeries).DontSaveData:=True;
    end;

    try
      {$IFDEF D5}
      Writer := {$IFDEF CLR}TWriterAccess{$ELSE}TWriter{$ENDIF}.Create(AStream, 4096);
      try
        tmpOwner:=AChart.Owner;
        if not Assigned(tmpOwner) then tmpOwner:=AChart;

        {$IFDEF CLR}
        Writer.DoSetRoot(tmpOwner);  { 5.01 }
        {$ELSE}
        TWriterAccess(Writer).SetRoot(tmpOwner);  { 5.01 }
        {$ENDIF}

        Writer.WriteSignature;
        Writer.WriteComponent(AChart);
      finally
        Writer.Free;
      end;
      {$ELSE}
      AStream.WriteComponent(AChart);
      {$ENDIF}

    finally
      for t:=0 to AChart.SeriesCount-1 do
      begin
        tmpSeries:=AChart[t];
        TSeriesAccess(tmpSeries).ForceSaveData:=False;
        TSeriesAccess(tmpSeries).DontSaveData:=False;
      end;
    end;

    AChart:=tmp;
    if not (csDesigning in AChart.ComponentState) then
       AChart.Name:=OldName;

    { write the Series data points }
    //if IncludeData then WriteChartData(AStream,AChart);

    if TextFormat then
    begin
      AStream.Position:=0;
      ConvertTeeToText(AStream,DestStream);
    end;

  finally
    if TextFormat then
       AStream.Free;
  end;
end;

Procedure SaveChartToXMLStream(AChart:TCustomChart; AStream:TStream;
                               IncludeData:Boolean=True;
                               XMLHeader:Boolean=True);
begin
  SaveChartToStream(AChart,AStream,IncludeData,True);
  AStream.Position:=0;
  ConvertTextToXML(AStream,XMLHeader);
end;

Procedure SaveChartToFile(AChart:TCustomChart; Const AFileName:String;
                          IncludeData:Boolean=True;
                          TextFormat:Boolean=False);
Var tmp : TFileStream;
begin
  tmp:=TFileStream.Create(TeeCheckExtension(AFileName),fmCreate);
  try
    SaveChartToStream(AChart,tmp,IncludeData,TextFormat);
  finally
    tmp.Free;
  end;
end;

Procedure SaveChartToXMLFile(AChart:TCustomChart; Const AFileName:String;
                             IncludeData:Boolean=True;
                             XMLHeader:Boolean=True);
Var tmp : TFileStream;
begin
  tmp:=TFileStream.Create(TeeCheckExtension(AFileName),fmCreate);
  try
    SaveChartToXMLStream(AChart,tmp,IncludeData,XMLHeader);
  finally
    tmp.Free;
  end;
end;

Function ColorToHex(const Color:TColor):String;
begin
  with RGBValue(ColorToRGB(Color)) do
       result:=Format('#%.2x%.2x%.2x',[Red,Green,Blue]);
end;

{ TSeriesData }
Constructor TSeriesData.Create(AChart:TCustomChart; ASeries:TChartSeries=nil);
begin
  inherited Create;
  FChart:=AChart;
  FSeries:=ASeries;
  FIncludeLabels:=True;
end;

Procedure TSeriesData.GuessSeriesFormat;
var tmp : TChartSeries;
    t   : Integer;
begin
  tmp := nil;

  if Assigned(FSeries) then
     tmp:=FSeries
  else
  if Assigned(FChart) and (FChart.SeriesCount > 0) then
  begin
    for t:=0 to FChart.SeriesCount-1 do // MS: 7.02 fix if first series is empty
        if FChart[t].Count<>0 then
        begin
          tmp:=FChart[t];
          break;
        end;
  end;

  if Assigned(tmp) then
     IFormat:=SeriesGuessContents(tmp);
end;

Procedure TSeriesData.Prepare;
begin
  GuessSeriesFormat;

  if not IncludeLabels then
     Exclude(IFormat,tfLabel);

  if not IncludeColors then
     Exclude(IFormat,tfColor);
end;

Function TSeriesData.AsString:String;
Var tmp : Integer;
    t   : Integer;
begin
  Prepare;
  result:='';

  tmp:=MaxSeriesCount;

  for t:=0 to tmp-1 do
      result:=result+PointToString(t)+TeeTextLineSeparator;
end;

Function TSeriesData.MaxSeriesCount:Integer;
var t : Integer;
begin
  if Assigned(FSeries) then
     result:=FSeries.Count
  else
  begin
    result:=0;

    if Assigned(FChart) then
    for t:=0 to FChart.SeriesCount-1 do
        result:=Math.Max(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;
  FTextQuotes:='';
end;

function TSeriesDataText.AsString: String;

  Function Header:String;

    Function HeaderSeries(ASeries:TChartSeries):String;

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

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

        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:=TextQuotes+TeeMsg_Index+TextQuotes
                    else result:='';

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

    if tfColor in IFormat then
    begin
      if result<>'' then result:=result+TextDelimiter;
      result:=result+TextQuotes+TeeMsg_Colors+TextQuotes;
    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;

procedure TSeriesDataText.GuessSeriesFormat;
var t : Integer;
    tmp : TeeFormatFlag;
begin
  inherited;

  if (not Assigned(Series)) and IncludeLabels and (not (tfLabel in IFormat)) then
  for t:=0 to Chart.SeriesCount-1 do
  begin
    tmp:=SeriesGuessContents(Chart[t]);
    if tfLabel in tmp then
    begin
      Include(IFormat, tfLabel);
      break;
    end;
  end;
end;

function TSeriesDataText.PointToString(Index: Integer): String;
var
  SomethingAdded : Boolean;

  Procedure Add(Const St:String);
  begin
    if not SomethingAdded then // 8.01 TV52012444
       result:=St
    else
       result:=result+TextDelimiter+St;

    SomethingAdded:=True;
  end;

var
  tmpNum : Integer;

  Procedure DoSeries(ASeries:TChartSeries);

    Function ValueToStr(ValueList:TChartValueList; Index:Integer):String;  // 6.02
    begin
      if ASeries.Count>Index then
         if ValueList.DateTime then
            result:=TextQuotes+DateTimeToStr(ValueList.Value[Index])+TextQuotes
         else
         if FValueFormat='' then
            result:=FloatToStr(ValueList.Value[Index])
         else
            result:=FormatFloat(FValueFormat,ValueList.Value[Index])
      else
         result:='';
    end;

    Function FirstSeriesLabel(Index:Integer):String;  // 7.0
    var t : Integer;
    begin
      result:='';

      if Assigned(Series) then
      begin
        if Series.Count>Index then result:=Series.Labels[Index];
      end
      else
      for t:=0 to Chart.SeriesCount-1 do
        if Chart[t].Count>Index then
        begin
          result:=Chart[t].Labels[Index];
          if result<>'' then break;
        end;

      if result<>'' then result:=TextQuotes+result+TextQuotes;
    end;

  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(FirstSeriesLabel(Index));

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

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

    { the "Y" point value }
    Add(ValueToStr(ASeries.MandatoryValueList,Index));

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

var t : Integer;
begin
  result:='';
  SomethingAdded:=False;

  { Point number? }
  if IncludeIndex then
     Add(TeeStr(Index));

  { 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;
  FEncoding:=TeeDefaultXMLEncoding;
end;

function TSeriesDataXML.IsEncodingStored:Boolean;
begin
  result:=(Encoding<>'') and (Encoding<>TeeDefaultXMLEncoding);
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 }