teestore.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

    SInput.Free;
  end;
end;

{ Create a text file from a binary *.tee file }
Procedure ConvertTeeFileToText(Const InputFile,OutputFile:String);
begin
  ConvertTeeFile(InputFile,OutputFile,True);
end;

{ Create a binary file from a text *.tee file }
Procedure ConvertTeeFileToBinary(Const InputFile,OutputFile:String);
begin
  ConvertTeeFile(InputFile,OutputFile,False);
end;

{
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;

  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);
    AStream.Free;
  end;
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;

Function ColorToHex(Color:TColor):String;
begin
  with RGBValue(ColorToRGB(Color)) do
    result:=Format('#%.2x%.2x%.2x',[rgbtRed,rgbtGreen,rgbtBlue]);
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;
    i   : Integer;
begin
  tmp := nil;

  if Assigned(FSeries) then
     tmp:=FSeries
  else
  if (FChart.SeriesCount > 0) then
  begin
    for i := 0 to FChart.SeriesCount -1 do // MS: 7.02 fix if first series is empty
        if FChart.Series[i].Count <> 0 then
        begin
          tmp := FChart.Series[i];
          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:=-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;
  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;

  Procedure Add(Const St:String);
  begin
    if result='' then result:=St
                 else result:=result+TextDelimiter+St;
  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
  { 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;
  FEncoding:=DefaultEncoding;
end;

function TSeriesDataXML.DefaultEncoding:String;
begin
  {$IFNDEF LINUX}
  {$IFNDEF LCL}
  if SysLocale.PriLangID=LANG_JAPANESE then
     result:='shift_jis'
  else
  {$ENDIF}
  {$ENDIF}
     result:='ISO-8859-1';
end;

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