teeflexcanvas.pas

BCB第三方组件

{**********************************************}
{   TeeChart and TeeTree for Adobe Flex/Flash  }
{                                              }
{   Copyright (c) 2007 by Steema Software      }
{   All Rights Reserved                        }
{**********************************************}
unit TeeFlexCanvas;
{$I TeeDefs.inc}

interface

uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes, SysUtils,
     {$IFDEF CLX}
     QGraphics, QForms, QButtons, QControls, QStdCtrls, QExtCtrls,
     QClipbrd, QDialogs,
     {$ELSE}
     Graphics, Forms, Buttons, Controls, StdCtrls, ExtCtrls,
     Clipbrd, FileCtrl,
     {$ENDIF}
     {$IFDEF D6}
     Types,
     {$ENDIF}
     TeeConst, TeCanvas, TeeProcs, TeEngine, TeeExport;

const
  TeeMsg_AsFlex='as Flex (Flash)';
  TeeMsg_FlexFilter='Flex Flash files (*.mxml)|*.mxml';

type
  TFlexCanvas=class(TTeeCanvas3D, ICanvasHyperlinks, ICanvasToolTips)
  private
    FBackColor   : TColor;
    FBackMode    : TCanvasBackMode;
    FTextAlign   : TCanvasTextAlign;
    FX           : Integer;
    FY           : Integer;
    FStrings     : TStrings;

    IAddedInitApp : Boolean;
    IApplication : Integer;
    IChartPen    : TChartPen;
    IIdent       : String;
    IItems       : TStrings;
    IImageID     : Integer;
    IPanel       : TCustomTeePanel;
    IPath        : TStrings;
    IScript      : Integer;
    ISmallDots   : Boolean;
    ITransp      : TTeeTransparency;

    procedure AddItem(const S:String); {$IFDEF D10}inline;{$ENDIF}
    procedure AddTag(const ATag,AText:String);

    // ICanvasHyperlinks
    procedure AddLink(x,y:Integer; const Text,URL,Hint:String);

    // ICanvasToolTips
    procedure AddToolTip(const Entity,ToolTip:String);

    function BrushColor:String;
    procedure CalcArcAngles(XC,YC,StartX,StartY,EndX,EndY:Integer;
                            out StartAngle:Single; out EndAngle:Single);
    function FlexAlpha:String;
    function FlexFloatToStr(const Value:Double):String;

    function FlexFont(AFont:TFont):String;
    function FlexGradient(Gradient:TCustomTeeGradient):String; overload;
    function FlexGradient(StartColor,EndColor:TColor; Direction:TGradientDirection;
                          Balance: Integer):String; overload;

    function FlexPoints(const Points: Array of TPoint):String;
    function FlexPosition(x,y:Integer):String;
    function FlexSize(w,h:Integer):String; overload;
    function FlexSize(const R:TRect):String; overload;
    function ImageFileName(Graphic:TGraphic):String;
    function PenColor:String;
    function PenWidth:String;
  protected
    { Protected declarations }

    procedure BeginEntity(const Entity:String); override;
    procedure EndEntity; override;

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

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

    Constructor Create(Panel:TCustomTeePanel; AStrings:TStrings);
    Destructor Destroy; override;

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

    procedure Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer); override;
    procedure AssignVisiblePenColor(APen:TPen; AColor:TColor); 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 Polygon(const Points: array of TPoint); override;
    Procedure PolygonGradient(const Points: Array of TPoint; Gradient:TCustomTeeGradient); 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 TextOut3D(X,Y,Z:Integer; const Text:String); override;
  end;

  TFlexOptions = class(TForm)
    BCompile: TButton;
    ETemp: TEdit;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    Label2: TLabel;
    EFlex: TEdit;
    SpeedButton2: TSpeedButton;
    CBPreview: TCheckBox;
    AC_OETags_js: TMemo;
    Chart1_html: TMemo;
    CBDelete: TCheckBox;
    CBEmbedd: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure BCompileClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure ETempChange(Sender: TObject);
    procedure EFlexChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure CheckCompile;
    function Compile(const TargetFile:String):Boolean;
    procedure ReadOptions;
  public
    { Public declarations }
    Panel : TCustomTeePanel;
  end;

  TFlexExportFormat=class(TTeeExportFormat)
  private
    Procedure CheckProperties;
  protected
    FProperties : TFlexOptions;
    Procedure DoCopyToClipboard; override;
  public
    EmbeddImages : Boolean;
    ImagePath    : String;

    function Compile(const TargetFile:String):Boolean;
    function Description:String; override;
    function FileExtension:String; override;
    function FileFilter:String; override;
    Function FlexMXML:TStringList;
    Function Options(Check:Boolean=True):TForm; override;
    Procedure SaveToStream(Stream:TStream); override;
  end;

procedure TeeSaveToFlexFile( APanel:TCustomTeePanel; const FileName: WideString;
                             AWidth:Integer=0; AHeight:Integer=0;
                             EmbededImages:Boolean=True);

implementation

{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}

{$R TeeFlexCanvas.res}

uses
  {$IFNDEF CLX}
  {$IFNDEF CLR}
  jpeg,
  {$ENDIF}
  {$ENDIF}

  Math,

  {$IFDEF CLR}
  TeeJPEG,
  System.Text,  // <-- StringBuilder
  WinUtils,
  {$ELSE}
  TeeDosCommand,
  {$ENDIF}

  TeeStringsEditor, TeePenDlg;

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:='0x'+IntToHex(GetRValue(AColor),2)+
                IntToHex(GetGValue(AColor),2)+
                IntToHex(GetBValue(AColor),2);

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

Function FlexColor(AColor:TColor):String;
begin
  result:='"'+ColorInternal(AColor)+'"';
end;

{ TFlexCanvas }
Constructor TFlexCanvas.Create(Panel:TCustomTeePanel; AStrings:TStrings);
begin
  inherited Create;

  IPanel:=Panel;
  EmbeddImages:=True;
  FStrings:=AStrings;
  UseBuffer:=False;
  SupportsID:=True;

  IPath:=TStringList.Create;
  IItems:=TStringList.Create;
  IImageID:=0;
end;

Destructor TFlexCanvas.Destroy;
begin
  IItems.Free;
  IPath.Free;
  inherited;
end;

procedure TFlexCanvas.CalcArcAngles(XC,YC,StartX,StartY,EndX,EndY:Integer; out StartAngle:Single; out EndAngle:Single);
const
  HalfDivPi=180.0/Pi;
begin
  StartAngle:=ArcTan2(YC-StartY,StartX-XC);
  if StartAngle<0 then
     StartAngle:=StartAngle+2.0*Pi;

  StartAngle:=StartAngle*HalfDivPi;

  EndAngle:=ArcTan2(YC-EndY,EndX-XC);
  if EndAngle<0 then
     EndAngle:=EndAngle+2.0*Pi;

  EndAngle:=EndAngle*HalfDivPi;
end;

procedure TFlexCanvas.Arc(const Left, Top, Right, Bottom, StartX, StartY,
  EndX, EndY: Integer);
var StartAngle : Single;
    EndAngle   : Single;
begin
  if Pen.Style<>psClear then
  begin
    CalcArcAngles((Left+Right) div 2,(Top+Bottom) div 2,
                  StartX,StartY,EndX,EndY,StartAngle,EndAngle);

    AddTag('tee:Arc',
      'x0="'+IntToStr(Left)+'" y0="'+IntToStr(Top)+'" '+
      'x1="'+IntToStr(Right)+'" y1="'+IntToStr(Bottom)+'" '+
      'startAngle="'+FlexFloatToStr(StartAngle)+
      '" endAngle="'+FlexFloatToStr(EndAngle)+'" '+
      FlexAlpha+
      PenColor+
      PenWidth);
  end;
end;

procedure TFlexCanvas.AssignVisiblePenColor(APen:TPen; AColor:TColor);
begin
  if APen is TChartPen then
  begin
    IChartPen:=TChartPen(APen);
    Pen.Width:=APen.Width;
    Pen.Color:=APen.Color;
    Pen.Style:=APen.Style;
  end
  else
     IChartPen:=nil;

  ISmallDots:=Assigned(IChartPen) and IChartPen.SmallDots;

  inherited;
end;

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

procedure TFlexCanvas.ClipCube(const Rect: TRect; MinZ, MaxZ: Integer);
begin
// TODO
  inherited;
end;

procedure TFlexCanvas.ClipRectangle(const Rect: TRect);
begin
// TODO
  inherited;
end;

function TFlexCanvas.ImageFileName(Graphic:TGraphic):String;

  procedure CalcResult(tmp:TGraphic);
  var tmpExt : String;
  begin
    {$IFDEF CLX}
    tmpExt:='jpg';
    {$ELSE}
    tmpExt:=GraphicExtension(TGraphicClass(tmp.ClassType));
    {$ENDIF}

    result:='TeeChart_Flex_Temp_'+IntToStr(IImageID)+'.'+tmpExt;
    Inc(IImageID);

    tmp.SaveToFile(ImagePath+'\'+result);
  end;

{$IFNDEF CLX}
var tmp : TGraphic;
{$ENDIF}
begin
  {$IFNDEF CLX}
  if TGraphicClass(Graphic.ClassType)=TBitmap then
  begin
    // Bitmap (*.bmp) not supported by Flash.
    // Save it to jpeg / png...

    tmp:=TJPEGImage.Create;
    try
      tmp.Assign(Graphic);

      CalcResult(tmp);
    finally
      tmp.Free;
    end;
  end
  else
  {$ENDIF}
    CalcResult(Graphic);
end;

function TFlexCanvas.FlexPosition(x,y:Integer):String;
begin
//  result:='x="'+FloatToStr(x*100/IPanel.Width)+'%" y="'+FloatToStr(y*100/IPanel.Height)+'%"';

  result:='x="'+IntToStr(x)+'" y="'+IntToStr(y)+'"';
end;

procedure TFlexCanvas.Draw(X, Y: Integer; Graphic: TGraphic);

  function ImageSource:String;
  begin
    if EmbeddImages then
       result:='@Embed('''+ImageFileName(Graphic)+''')'
    else
       result:=ImageFileName(Graphic);
  end;

begin
  if Assigned(Graphic) then
     AddTag('mx:Image',FlexPosition(x,y)+' source="'+ImageSource+'"');
end;

function TFlexCanvas.PenColor:String;
begin
  if Pen.Style=psClear then
     result:=' strokeColor=""'
  else
     result:=' strokeColor='+FlexColor(Pen.Color);
end;

function TFlexCanvas.FlexSize(w,h:Integer):String;
begin
  result:='width="'+IntToStr(w)+'" height="'+IntToStr(h)+'"';
end;

function TFlexCanvas.FlexSize(const R:TRect):String;
begin
  result:=FlexSize(R.Right-R.Left, R.Bottom-R.Top);
end;

procedure TFlexCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
begin
  AddTag('tee:Ellipse',FlexPosition(X1,Y1)+' '+FlexSize(X2-X1,Y2-Y1)+
         FlexAlpha+BrushColor+PenColor+PenWidth);
end;

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

procedure TFlexCanvas.FillRect(const Rect: TRect);
begin
  AddTag('tee:Rectangle',FlexPosition(Rect.Left,Rect.Top)+' '+
      FlexSize(Rect)+' '+
      FlexAlpha+'strokeColor="" '+BrushColor);
end;

function TFlexCanvas.GetBackColor: TColor;