teeavaloncanvas.pas

TeeChart 7.0 With Source在Delphi 7.0中的安装

  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
     Add('<v:oval style="position:absolute;left:'+IntToStr(X1)+';top:'+IntToStr(Y1)+
         ';height:'+IntToStr(Y2-Y1)+';width:'+IntToStr(X2-X1)+'" fillcolor='+
         AvalonColor(Brush.Color)+AvalonPen('oval'));
end;

procedure TAvalonCanvas.SetPixel3D(X,Y,Z:Integer; Value: TColor);
begin
  if Pen.Style<>psClear then
  begin
    Calc3DPos(x,y,z);
    Pen.Color:=Value;
    MoveTo(x,y);
    LineTo(x,y);
  end;
end;

procedure TAvalonCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
  if Pen.Style<>psClear then
  begin
    Pen.Color:=Value;
    MoveTo(x,y);
    LineTo(x,y);
  end;
end;

procedure TAvalonCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var tmpSt : String;
begin
  if Pen.Style<>psClear then
  begin
    PrepareShape;
    tmpSt:=' <v:path v="ar ';
    tmpSt:=tmpSt+PointToStr(X1,Y1)+' '+PointToStr(X2,Y2)+' '+
      PointToStr(X3,Y3)+' '+PointToStr(X4,Y4);

    Add(tmpSt+' e"/>');
    Add('</v:shape>');
  end;
end;

procedure TAvalonCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
var tmpSt : String;
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    PrepareShape;
    tmpSt:=' <v:path v="m '+PointToStr((X2+X1) div 2,(Y2+Y1) div 2)+' at ';
    tmpSt:=tmpSt+PointToStr(X1,Y1)+' '+PointToStr(X2,Y2)+' '+
      PointToStr(X3,Y3)+' '+PointToStr(X4,Y4);

    Add(tmpSt+' x e"/>');
    Add('</v:shape>');
  end;
end;

procedure TAvalonCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  InternalRect(TeeRect(X1,Y1,X2,Y2),True,True);
end;

Procedure TAvalonCanvas.TextOut3D(X,Y,Z:Integer; const Text:String);

  Function FontStyle:String;
  begin
    if Font.Style=[] then result:=''
    else
    begin
      result:='';

      if fsBold in Font.Style then
         result:=' font-weight=bold;';

      if fsItalic in Font.Style then
         result:=result+' font-style=italic;';

      if fsUnderline in Font.Style then
         result:=result+' text-decoration=underline;';

      if fsStrikeOut in Font.Style then
         result:=result+' text-decoration=line-through;';
    end;
  end;

  Procedure DoText(AX,AY:Integer; AColor:TColor);
  begin
    if (TextAlign and TA_CENTER)=TA_CENTER then
       Dec(AX,TextWidth(Text) div 2)
    else
    if (TextAlign and TA_RIGHT)=TA_RIGHT then
       Dec(AX,TextWidth(Text));

    Inc(AX);
    Inc(AY);

    Add('<v:textbox style="position:absolute; left:'+IntToStr(AX)+'; top:'+IntToStr(AY)+
        '; color:'+ColorInternal(AColor)+'; text-align:left; '+
        ' font-family:'+Font.Name+'; font-size:'+TeeStr(Round(Font.Size*1.4))+'; '+FontStyle+'">');

    Add(Text);

    Add('</v:textbox>');
  end;

Var tmpX : Integer;
    tmpY : Integer;
begin
  Calc3DPos(x,y,z);

  if Assigned(IFont) then
  With IFont.Shadow do
  if (HorizSize<>0) or (VertSize<>0) then
  begin
    if HorizSize<0 then
    begin
      tmpX:=X;
      X:=X-HorizSize;
    end
    else tmpX:=X+HorizSize;

    if VertSize<0 then
    begin
      tmpY:=Y;
      Y:=Y-VertSize;
    end
    else tmpY:=Y+VertSize;

    DoText(tmpX,tmpY,IFont.Shadow.Color)
  end;

  DoText(X,Y,IFont.Color);
end;

Procedure TAvalonCanvas.TextOut(X,Y:Integer; const Text:String);
begin
  TextOut3D(x,y,0,Text);
end;

procedure TAvalonCanvas.MoveTo3D(X,Y,Z:Integer);
begin
  Calc3DPos(x,y,z);
  MoveTo(x,y);
end;

procedure TAvalonCanvas.LineTo3D(X,Y,Z:Integer);
begin
  Calc3DPos(x,y,z);
  LineTo(x,y);
end;

Function TAvalonCanvas.GetTextAlign:TCanvasTextAlign;
begin
  result:=FTextAlign;
end;

Procedure TAvalonCanvas.DoHorizLine(X0,X1,Y:Integer);
begin
  MoveTo(X0,Y);
  LineTo(X1,Y);
end;

Procedure TAvalonCanvas.DoVertLine(X,Y0,Y1:Integer);
begin
  MoveTo(X,Y0);
  LineTo(X,Y1);
end;

procedure TAvalonCanvas.RotateLabel3D(x,y,z:Integer; Const St:String; RotDegree:Double);
begin
//TODO: RotDegree rotation
  Calc3DPos(x,y,z);
  TextOut(X,Y,St);
end;

procedure TAvalonCanvas.RotateLabel(x,y:Integer; Const St:String; RotDegree:Double);
begin
  RotateLabel3D(x,y,0,St,RotDegree);
end;

Procedure TAvalonCanvas.Line(X0,Y0,X1,Y1:Integer);
begin
  MoveTo(X0,Y0);
  LineTo(X1,Y1);
end;

Procedure TAvalonCanvas.HorizLine3D(Left,Right,Y,Z:Integer);
begin
  MoveTo3D(Left,Y,Z);
  LineTo3D(Right,Y,Z);
end;

Procedure TAvalonCanvas.VertLine3D(X,Top,Bottom,Z:Integer);
begin
  MoveTo3D(X,Top,Z);
  LineTo3D(X,Bottom,Z);
end;

Procedure TAvalonCanvas.ZLine3D(X,Y,Z0,Z1:Integer);
begin
  MoveTo3D(X,Y,Z0);
  LineTo3D(X,Y,Z1);
end;

Procedure TAvalonCanvas.LineWithZ(X0,Y0,X1,Y1,Z:Integer);
begin
  MoveTo3D(X0,Y0,Z);
  LineTo3D(X1,Y1,Z);
end;

Function TAvalonCanvas.GetBackMode:TCanvasBackMode;
begin
  result:=FBackMode;
end;

Procedure TAvalonCanvas.PolygonFour;
begin
  Polygon(IPoints);
end;

Function TAvalonCanvas.PrepareShape:String;
begin
  result:='<v:shape style="position:absolute;'+TheBounds+'"';
  if Brush.Style<>bsClear then
     result:=result+' fillcolor='+AvalonColor(Brush.Color)
  else
     result:=result+' filled="f"';

  if Pen.Style=psClear then
     result:=result+' stroked="f"'
  else
     result:=result+' strokecolor='+AvalonColor(Pen.Color);

  Add(result+'>');
end;

Procedure TAvalonCanvas.Polygon(const Points: Array of TPoint);
var tmpSt : String;
    t     : Integer;
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    PrepareShape;
    tmpSt:=' <v:path v="m '+PointToStr(Points[0].X,Points[0].Y)+' l ';
    for t:=1 to High(Points) do
       tmpSt:=tmpSt+PointToStr(Points[t].X,Points[t].Y)+' ';

    Add(tmpSt+' x e"/>');
    Add('</v:shape>');
  end;
end;

Procedure TAvalonCanvas.Polyline(const Points: {$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF});
var tmpSt : String;
    t     : Integer;
begin
  if Pen.Style<>psClear then
  begin
    PrepareShape;
    tmpSt:=' <v:path v="m '+PointToStr(Points[0].X,Points[0].Y)+' l ';
    for t:=1 to High(Points) do
       tmpSt:=tmpSt+PointToStr(Points[t].X,Points[t].Y)+' ';

    Add(tmpSt+' e"/>');
    Add('</v:shape>');
  end;
end;

function TAvalonCanvas.InitWindow(DestCanvas: TCanvas;
  A3DOptions: TView3DOptions; ABackColor: TColor; Is3D: Boolean;
  const UserRect: TRect): TRect;
begin
  result:=inherited InitWindow(DestCanvas,A3DOptions,ABackColor,Is3D,UserRect);
  Add('<v:group style="'+TheBounds+
       '" coordsize="'+
       PointToStr(Bounds.Right-Bounds.Left,Bounds.Bottom-Bounds.Top)+'"'+
       ' coordorigin="'+PointToStr(Bounds.Top,Bounds.Left)+
       '">');

  Pen.OnChange:=ChangedPen;
end;

procedure TAvalonCanvas.ChangedPen(Sender: TObject);
begin
  IPenStyle:=Pen.Style;
  IPenWidth:=Pen.Width;
end;

procedure TAvalonCanvas.SetTextAlign(Align: TCanvasTextAlign);
begin
  FTextAlign:=Align;
end;

function TAvalonCanvas.BeginBlending(const R: TRect;
  Transparency: TTeeTransparency): TTeeBlend;
begin
  ITransp:=Transparency;
  result:=nil;
end;

procedure TAvalonCanvas.EndBlending(Blend: TTeeBlend);
begin  // reset to zero
  ITransp:=0;
end;

{ TAvalonExportFormat }
function TXAMLExportFormat.Description: String;
begin
  result:=TeeMsg_AsXAML;
end;

procedure TXAMLExportFormat.DoCopyToClipboard;
begin
  with XAML do
  try
    Clipboard.AsText:=Text;
  finally
    Free;
  end;
end;

function TXAMLExportFormat.FileExtension: String;
begin
  result:='XAML';
end;

function TXAMLExportFormat.FileFilter: String;
begin
  result:=TeeMsg_XAMLFilter;
end;

function TXAMLExportFormat.Options(Check:Boolean=True): TForm;
begin
  result:=nil;
end;

procedure TXAMLExportFormat.SaveToStream(Stream: TStream);
begin
  with XAML do
  try
    SaveToStream(Stream);
  finally
    Free;
  end;
end;

type
  TTeePanelAccess=class(TCustomTeePanel);

// Returns a panel or chart in VML format into a StringList
function TXAMLExportFormat.XAML: TStringList;
var tmp : TCanvas3D;
begin
  CheckSize;
  result:=TStringList.Create;
  Panel.AutoRepaint:=False;

  try
    {$IFNDEF CLR} // Protected across assemblies
    tmp:=TTeePanelAccess(Panel).InternalCanvas;
    TTeePanelAccess(Panel).InternalCanvas:=nil;
    {$ENDIF}

    Panel.Canvas:=TAvalonCanvas.Create(result);

    if not Assigned(Panel.Parent) then
      Panel.BufferedDisplay:=True;  // 7.01

    try
      Panel.Draw(Panel.Canvas.ReferenceCanvas,TeeRect(0,0,Width,Height));
      { insert html headings at top }
      result.Insert(0,'<!-- Generated by TeeChart Pro Version '+TeeChartVersion+' -->');
      result.Insert(0,'<body>');
      result.Insert(0,'<html>');

      { add html headings at bottom }
      result.Add('</body>');
      result.Add('</html>');
    finally
      {$IFNDEF CLR} // Protected across assemblies
      Panel.Canvas:=tmp;
      {$ENDIF}
    end;
  finally
    Panel.AutoRepaint:=True;
  end;
end;

procedure TeeSaveToXAMLFile( APanel:TCustomTeePanel; const FileName: WideString;
                             AWidth:Integer=0;
                             AHeight: Integer=0);
begin { save panel or chart to filename in VML (html) format }
  with TXAMLExportFormat.Create do
  try
    Panel:=APanel;
    Height:=AHeight;
    Width:=AWidth;
    SaveToFile(FileName);
  finally
    Free;
  end;
end;

initialization
  RegisterTeeExportFormat(TXAMLExportFormat);
finalization
  UnRegisterTeeExportFormat(TXAMLExportFormat);
end.