teestore.pas

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

      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;
  var
    tmp: string;
    Index: Integer;
  begin
    tmp := GetGallerySeriesName(ASeries);
    Index := Pos('&', tmp);
    if Index > 0 then		// '&' --> '&amp;'
       Insert('amp;', tmp, Index + 1);
    result:=
          '<series title="'+SeriesTitleOrName(ASeries)+'" type="'+
          tmp+'" 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
  begin
    result:='<?xml version="1.0"';
    if Encoding<>'' then
       result:=result+' encoding="'+Encoding+'"';

    result:=result+'?>'+TeeTextLineSeparator;
  end
  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
    {$IFDEF CLR}
    AStream.Write(Value);
    AStream.Write(Size);
    {$ELSE}
    Buf[0]:=Value;
    Buf[1]:=Size;
    AStream.Write(Buf,2*SizeOf(Word));
    {$ENDIF}
  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);
    {$IFDEF CLR}
    AStream.Write(Attr[0]);
    AStream.Write(Attr[1]);
    AStream.Write(Attr[2]);
    {$ELSE}
    AStream.Write(Attr,SizeOf(Attr));
    {$ENDIF}
  end;

  procedure WriteDouble(Const Value:Double);
  begin
    WriteParams(3,SizeOf(Double));
    {$IFDEF CLR}
    AStream.Write(Value);
    {$ELSE}
    AStream.WriteBuffer(Value,SizeOf(Double));
    {$ENDIF}
  end;

  procedure WriteText(Const Value:ShortString);
  {$IFDEF CLR}
  var l : Byte;
  {$ENDIF}
  begin
    WriteParams(4,Length(Value)+1);
    {$IFDEF CLR}
    l:=Length(Value);
    AStream.Write(l);
    AStream.Write(BytesOf(Value),l);
    {$ELSE}
    AStream.Write(Value,Length(Value)+1)
    {$ENDIF}
  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;
  {$IFDEF CLR}
  AStream.Write(BeginExcel[0]); { begin and BIF v5 }
  AStream.Write(BeginExcel[1]);
  AStream.Write(BeginExcel[2]);
  AStream.Write(BeginExcel[3]);
  AStream.Write(BeginExcel[4]);
  AStream.Write(BeginExcel[5]);
  {$ELSE}
  AStream.WriteBuffer(BeginExcel,SizeOf(BeginExcel)); { begin and BIF v5 }
  {$ENDIF}

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

  {$IFDEF CLR}
  AStream.Write(Buf[0]);
  AStream.Write(Buf[1]);
  AStream.Write(Buf[2]);
  AStream.Write(Buf[3]);
  AStream.Write(Buf[4]);
  {$ELSE}
  AStream.Write(Buf,5*SizeOf(Word));
  {$ENDIF}

  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;

  {$IFDEF CLR}
  AStream.Write(EndExcel[0]); { end }
  AStream.Write(EndExcel[1]); { end }
  {$ELSE}
  AStream.WriteBuffer(EndExcel,SizeOf(EndExcel)); { end }
  {$ENDIF}
end;

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