teexamlcanvas.pas

BCB第三方组件

{*************************************************}
{ TeeChart Pro XAML (XAML) Canvas and Exporting   }
{ Windows Presentation Foundation Graphics        }
{ Copyright (c) 2004-2007 by David Berneda        }
{ All Rights Reserved                             }
{*************************************************}
unit TeeXAMLCanvas;
{$I TeeDefs.inc}

interface

uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes,
     {$IFDEF CLX}
     QGraphics, QForms,
     {$ELSE}
     Graphics, Forms,
     {$ENDIF}
     {$IFDEF D6}
     Types,
     {$ENDIF}
     TeCanvas, TeeProcs, TeEngine, TeeExport;


const
  TeeMsg_AsXAML='as XAML (WPF)';
  TeeMsg_XAMLFilter='XAML files (*.xaml)|*.xaml';

type
  TXAMLCanvas = class(TTeeCanvas3D)
  private
    { Private declarations }
    FBackColor   : TColor;
    FBackMode    : TCanvasBackMode;
    FTextAlign   : TCanvasTextAlign;
    FX           : Integer;
    FY           : Integer;
    FStrings     : TStrings;

    IPenStyle    : TPenStyle;
    IPenWidth    : Integer;
    ITransp      : TTeeTransparency;
    IPanel       : TCustomTeePanel;

    Procedure Add(Const S:String); {$IFDEF D10}inline;{$ENDIF}
    procedure ChangedPen(Sender: TObject);
    Procedure InternalRect(Const Rect:TRect; UsePen,IsRound:Boolean);
    Function PointToStr(X,Y:Integer):String;
    Function PrepareShape(const Prefix:String; UsePen:Boolean=True; UseBrush:Boolean=True):String;
    Function XAMLColor(AColor:TColor):String;
  protected
    { Protected declarations }

    { 2d }
    procedure SetPixel(X, Y: Integer; Value: TColor); override;
    Function GetTextAlign:TCanvasTextAlign; override;

    { 3d }
    procedure SetPixel3D(X,Y,Z:Integer; Value: TColor); override;
    Procedure SetBackMode(Mode:TCanvasBackMode); override;
    Function GetMonochrome:Boolean; override;
    Procedure SetMonochrome(Value:Boolean); override;
    Procedure SetBackColor(Color:TColor); override;
    Function GetBackMode:TCanvasBackMode; override;
    Function GetBackColor:TColor; override;
    procedure SetTextAlign(Align:TCanvasTextAlign); override;

    Function XAMLPen:String;
  public
    { Public declarations }
    Constructor Create(Panel:TCustomTeePanel; AStrings:TStrings);

    Function InitWindow( DestCanvas:TCanvas;
                         A3DOptions:TView3DOptions;
                         ABackColor:TColor;
                         Is3D:Boolean;
                         Const UserRect:TRect):TRect; override;

    procedure AssignVisiblePenColor(APen:TPen; AColor:TColor); override;

    procedure Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer); override;
    procedure Draw(X, Y: Integer; Graphic: TGraphic); override;
    procedure FillRect(const Rect: TRect); override;
    procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
    procedure LineTo(X,Y:Integer); override;
    procedure MoveTo(X,Y:Integer); override;
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
    procedure Rectangle(X0,Y0,X1,Y1:Integer); reintroduce; override;
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); override;
    procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); override;
    Procedure TextOut(X,Y:Integer; const Text:String); override;

    procedure ClipRectangle(Const Rect:TRect); override;
    procedure ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer); override;
    procedure UnClipRectangle; override;

    Procedure GradientFill( Const Rect:TRect;
                            StartColor,EndColor:TColor;
                            Direction:TGradientDirection;
                            Balance:Integer=50); override;
    procedure RotateLabel(x,y:Integer; Const St:String; RotDegree:Double); override;
    procedure RotateLabel3D(x,y,z:Integer;
                            Const St:String; RotDegree:Double); override;
    Procedure Polygon(const Points: array of TPoint); override;
    Procedure Polyline(const Points: {$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF}); override;

    Function BeginBlending(const R:TRect; Transparency:TTeeTransparency):TTeeBlend; override;
    procedure EndBlending(Blend:TTeeBlend); override;

    { 3d }
    Procedure ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect); override;
    procedure EllipseWithZ(X1, Y1, X2, Y2, Z:Integer); override;
    Procedure TextOut3D(X,Y,Z:Integer; const Text:String); override;
  end;

  TXAMLExportFormat=class(TTeeExportFormat)
  private
  protected
    Procedure DoCopyToClipboard; override;
  public
    function Description:String; override;
    function FileExtension:String; override;
    function FileFilter:String; override;
    Function XAML:TStringList;
    Function Options(Check:Boolean=True):TForm; override;
    Procedure SaveToStream(Stream:TStream); override;
  end;

procedure TeeSaveToXAMLFile( APanel:TCustomTeePanel; const FileName: WideString;
                             AWidth:Integer=0; AHeight: Integer=0);

implementation

Uses {$IFDEF CLX}
     QClipbrd,
     {$ELSE}
     Clipbrd,
     {$ENDIF}
     TeeConst, SysUtils;

{ TXAMLCanvas }
Constructor TXAMLCanvas.Create(Panel:TCustomTeePanel; AStrings:TStrings);
begin
  inherited Create;
  IPanel:=Panel;
  FStrings:=AStrings;
  UseBuffer:=False;
end;

Procedure TXAMLCanvas.ShowImage(DestCanvas,DefaultCanvas:TCanvas; Const UserRect:TRect);
begin
  Add('</Canvas>');
  Pen.OnChange:=nil;
end;

Procedure TXAMLCanvas.Add(Const S:String);
begin
  FStrings.Add(S);
end;

Function ColorInternal(AColor:TColor):String;
begin
  AColor:=ColorToRGB(AColor);

  case AColor of
    clBlack: result:='Black';
    clWhite: result:='White';
    clRed:   result:='Red';
    clGreen: result:='Green';
    clBlue:  result:='Blue';
   clYellow: result:='Yellow';
    clGray:  result:='Gray';
    clNavy:  result:='Navy';
    clOlive: result:='Olive';
    clLime:  result:='Lime';
    clTeal:  result:='Teal';
  clSilver:  result:='Silver';
  clPurple:  result:='Purple';
 clFuchsia:  result:='Fuchsia';
  clMaroon:  result:='Maroon';
  else
  begin
    result:='#'+IntToHex(GetRValue(AColor),2)+
                IntToHex(GetGValue(AColor),2)+
                IntToHex(GetBValue(AColor),2);

//    if result='#000000' then result:='#0';
  end;
  end;
end;

Function TXAMLCanvas.XAMLColor(AColor:TColor):String;
begin
  if ITransp<>0 then
  begin
    AColor:=ColorToRGB(AColor);
    
    result:='"#'+IntToHex(255-Round(2.55*ITransp),2)+
                IntToHex(GetRValue(AColor),2)+
                IntToHex(GetGValue(AColor),2)+
                IntToHex(GetBValue(AColor),2)+'"';
  end
  else
     result:='"'+ColorInternal(AColor)+'"';
end;

procedure TXAMLCanvas.Rectangle(X0,Y0,X1,Y1:Integer);
begin
  InternalRect(TeeRect(X0,Y0,X1,Y1),True,False);
end;

procedure TXAMLCanvas.MoveTo(X, Y: Integer);
begin
  FX:=X;
  FY:=Y;
end;

procedure TXAMLCanvas.AssignVisiblePenColor(APen:TPen; AColor:TColor);
begin
  IPenStyle:=APen.Style;
  IPenWidth:=APen.Width;
  Pen.OnChange:=nil;

  inherited;

  Pen.OnChange:=ChangedPen;
end;

Function TXAMLCanvas.XAMLPen:String;

  Function IsSmallDots:Boolean;
  begin
    result:=(Pen is TChartPen) and TChartPen(Pen).SmallDots;
  end;

  Function PenStyle:String;
  begin
    if IsSmallDots then
       result:='Dot'
    else
    Case IPenStyle of
      psSolid: ;
      psDash: result:='Dash';
      psDot: result:='Dot';
      psDashDot: result:='DashDot';
      psDashDotDot: result:='DashDotDot';
    end;
  end;

  function PenWidth:String;
  begin
    if (IPenStyle<>psSolid) and (IPenWidth=1) then
       result:=' StrokeThickness="2" '
    else
    if IPenWidth>1 then
       result:=' StrokeThickness="'+TeeStr(IPenWidth)+'" '
    else
       result:='';
  end;

begin
  result:=PenWidth+'Stroke='+XAMLColor(Pen.Color);  // Pen.Style

  if IPenStyle<>psSolid then
     result:=result+' StrokeDashArray="{Binding Source={x:Static DashStyles.'+PenStyle+'}, Path=Dashes}" StrokeDashCap="Round"';
end;

procedure TXAMLCanvas.LineTo(X, Y: Integer);
begin
  Add('<Line X1="'+TeeStr(FX)+'" X2="'+TeeStr(X)+
          '" Y1="'+TeeStr(FY)+'" Y2="'+TeeStr(Y)+'" '+XAMLPen+'/>');

  FX:=X;
  FY:=Y;
end;

procedure TXAMLCanvas.ClipRectangle(Const Rect:TRect);
begin
end;

procedure TXAMLCanvas.ClipCube(Const Rect:TRect; MinZ,MaxZ:Integer);
begin
end;

procedure TXAMLCanvas.UnClipRectangle;
begin
end;

function TXAMLCanvas.GetBackColor:TColor;
begin
  result:=FBackColor;
end;

procedure TXAMLCanvas.SetBackColor(Color:TColor);
begin
  FBackColor:=Color;
end;

procedure TXAMLCanvas.SetBackMode(Mode:TCanvasBackMode);
begin
  FBackMode:=Mode;
end;

Function TXAMLCanvas.GetMonochrome:Boolean;
begin
  result:=False;
end;

Procedure TXAMLCanvas.SetMonochrome(Value:Boolean);
begin
end;

function AddRectangle(Rect:TRect):String;
begin
  Rect:=OrientRectangle(Rect);

  result:=' Canvas.Left="'+TeeStr(Rect.Left)+
          '" Canvas.Top="'+TeeStr(Rect.Top)+
          '" Width="'+TeeStr(Rect.Right-Rect.Left+1)+
          '" Height="'+TeeStr(Rect.Bottom-Rect.Top+1)+'"';
end;

procedure TXAMLCanvas.StretchDraw(const Rect: TRect; Graphic: TGraphic);
begin
  Add('<Rectangle');
  Add(AddRectangle(Rect)+'>');
  Add(' <Rectangle.Fill>');
//  Add('  <ImageBrush ImageSource="sample.jpg"/>');
  Add(' </Rectangle.Fill>');
  Add('</Rectangle>');
end;

procedure TXAMLCanvas.Draw(X, Y: Integer; Graphic: TGraphic);
begin
  Add('<Rectangle');
  Add(AddRectangle(TeeRect(X,Y,X+Graphic.Width,Y+Graphic.Height))+'>');
  Add(' <Rectangle.Fill>');
//  Add('  <ImageBrush ImageSource="sample.jpg"/>');
  Add(' </Rectangle.Fill>');
  Add('</Rectangle>');
end;

(*
Function TXAMLCanvas.TheBounds:String;
begin
  result:='width:'+IntToStr(Bounds.Right-Bounds.Left)+
          ';height:'+IntToStr(Bounds.Bottom-Bounds.Top);
end;
*)

Function TXAMLCanvas.PointToStr(X,Y:Integer):String;
begin
  result:=TeeStr(X)+','+TeeStr(Y);
end;

Procedure TXAMLCanvas.GradientFill( Const Rect:TRect;
                                  StartColor,EndColor:TColor;
                                  Direction:TGradientDirection;
                                  Balance:Integer=50);

  function StartEndPoints:String;
  begin
    Case Direction of
       gdTopBottom  : result:=' StartPoint="0.5,1" EndPoint="0.5,0"';
       gdBottomTop  : result:=' StartPoint="0.5,0" EndPoint="0.5,1"';
       gdLeftRight  : result:='';
       gdRightLeft  : result:='';
       gdFromCenter : result:='';
       gdFromTopLeft: result:='';
    else
       result:='';
    end;
  end;

var tmp : String;
begin
  Add('<Rectangle'+AddRectangle(Rect)+'>');
  Add(' <Rectangle.Fill>');

  if Direction=gdRadial then
     tmp:='RadialGradientBrush'
  else
     tmp:='LinearGradientBrush';

  Add('   <'+tmp+StartEndPoints+'>');
  Add('    <GradientStop Offset="0" Color='+XAMLColor(StartColor)+'/>');
  Add('    <GradientStop Offset="1" Color='+XAMLColor(EndColor)+'/>');
  Add('  </'+tmp+'>');

  Add(' </Rectangle.Fill>');

//  if ITransp<>0 then
//       Add(' opacity="'+FloatToStr((100-ITransp)*0.01)+'"');

  Add('</Rectangle>');
end;

procedure TXAMLCanvas.FillRect(const Rect: TRect);
begin
  InternalRect(Rect,False,False);
end;

Procedure TXAMLCanvas.InternalRect(Const Rect:TRect; UsePen,IsRound:Boolean);
var tmp  : String;
begin
  if (Brush.Style<>bsClear) or (UsePen and (Pen.Style<>psClear)) then
  begin
    PrepareShape('Rectangle',UsePen);

    tmp:='';

    if IsRound then
       tmp:=tmp+' RadiusX="30" RadiusY="30"';

    tmp:=tmp+AddRectangle(Rect);

    (*
    if ITransp<>0 then
       tmp:=tmp+' opacity="'+FloatToStr((100-ITransp)*0.01)+'"';
    *)

    Add(tmp+'/>');
  end;
end;

procedure TXAMLCanvas.Ellipse(X1, Y1, X2, Y2: Integer);