teexamlcanvas.pas

BCB第三方组件

begin
  EllipseWithZ(X1,Y1,X2,Y2,0);
end;

procedure TXAMLCanvas.EllipseWithZ(X1, Y1, X2, Y2, Z: Integer);
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    Calc3DPos(X1,Y1,Z);
    Calc3DPos(X2,Y2,Z);

    PrepareShape('Ellipse');

    Add(' Canvas.Left="'+IntToStr(X1)+
        '" Canvas.Top="'+IntToStr(Y1)+
        '" Height="'+IntToStr(Y2-Y1+1)+
        '" Width="'+IntToStr(X2-X1+1)+'"');

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

procedure TXAMLCanvas.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 TXAMLCanvas.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 TXAMLCanvas.Arc(const Left, Top, Right, Bottom, StartX, StartY, EndX, EndY: Integer);
var tmpSt : String;
begin
  if Pen.Style<>psClear then
  begin
    PrepareShape('Arc');
    tmpSt:=' <v:path v="ar ';
    tmpSt:=tmpSt+PointToStr(Left,Top)+' '+PointToStr(Right,Bottom)+' '+
      PointToStr(StartX,StartY)+' '+PointToStr(EndX,EndY);

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

procedure TXAMLCanvas.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('Pie');
    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 TXAMLCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  InternalRect(TeeRect(X1,Y1,X2,Y2),True,True);
end;

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

  Function FontStyle:String;
  begin
    result:='';

    // Style

    if Font.Style<>[] then
    begin
      if fsBold in Font.Style then
         result:=result+' FontWeight="Bold"';

      if fsItalic in Font.Style then
         result:=result+' FontStyle="Italic"';

      // Not existent in our TeeFont class:
      (*
      if fsOblique in Font.Style then
         result:=result+' FontStyle="Oblique"';
      *)

      // Not existent in XAML
      (*
      if fsUnderline in Font.Style then
         result:=result+' FontStyle="Underline"';

      if fsStrikeOut in Font.Style then
         result:=result+' FontStyle="LineThrough"';
      *)
    end;

    // InterCharSize

    if Assigned(IFont) and (IFont.InterCharSize<>0) then
    if IFont.InterCharSize>3 then
       result:=result+' FontStretch="UltraExpanded"'
    else
    if IFont.InterCharSize>2 then
       result:=result+' FontStretch="ExtraExpanded"'
    else
    if IFont.InterCharSize>1 then
       result:=result+' FontStretch="Expanded"'
    else
    if IFont.InterCharSize>0 then
       result:=result+' FontStretch="SemiExpanded"'
    else
    if IFont.InterCharSize<-3 then
       result:=result+' FontStretch="UltraCondensed"'
    else
    if IFont.InterCharSize<-2 then
       result:=result+' FontStretch="ExtraCondensed"'
    else
    if IFont.InterCharSize<-1 then
       result:=result+' FontStretch="Condensed"'
    else
    if IFont.InterCharSize<0 then
       result:=result+' FontStretch="SemiCondensed"'
  end;

  Procedure DoText(AX,AY:Integer; AColor:TColor);
  var tmp : String;
  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);

    tmp:='<TextBlock Canvas.Left="'+TeeStr(AX)+
        '" Canvas.Top="'+TeeStr(AY)+
        '" Foreground='+XAMLColor(AColor)+' FontFamily="'+Font.Name+
        '" FontSize="'+TeeStr(Round(Font.Size*1.4))+'" '+FontStyle;

    if (BackMode=cbmOpaque) and (BackColor<>clTeeColor) then
       tmp:=tmp+' Background='+XAMLColor(BackColor);

    Add(tmp+'>');

    Add(Text);

    if fsUnderline in Font.Style then
    begin
      Add('<TextBlock.TextDecorations>');
      Add('    <TextDecorationCollection>');
      Add('      <TextDecoration');
      Add('        PenThicknessUnit="FontRecommended">');
      Add('        <TextDecoration.Pen>');
      Add('          <Pen Brush='+XAMLColor(Font.Color)+' Thickness="1" />');
      Add('        </TextDecoration.Pen>');
      Add('      </TextDecoration>');
      Add('    </TextDecorationCollection>');
      Add('  </TextBlock.TextDecorations>');
    end;

    Add('</TextBlock>');
  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 TXAMLCanvas.TextOut(X,Y:Integer; const Text:String);
begin
  TextOut3D(x,y,0,Text);
end;

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

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

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

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

Function TXAMLCanvas.PrepareShape(const Prefix:String; UsePen:Boolean=True; UseBrush:Boolean=True):String;
begin
  result:='<'+Prefix;

  if UseBrush and (Brush.Style<>bsClear) then
     result:=result+' Fill='+XAMLColor(Brush.Color);

  if UsePen and (Pen.Style<>psClear) then
     result:=result+' '+XAMLPen;

  Add(result);
end;

Procedure TXAMLCanvas.Polygon(const Points: Array of TPoint);
var tmpSt : String;
    t     : Integer;
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    PrepareShape('Polygon');

    tmpSt:=' Points="';

    for t:=Low(Points) to High(Points) do
        tmpSt:=tmpSt+PointToStr(Points[t].X,Points[t].Y)+' ';

    Add(tmpSt+'"/>');
  end;
end;

Procedure TXAMLCanvas.Polyline(const Points: {$IFDEF D5}Array of TPoint{$ELSE}TPointArray{$ENDIF});
var tmpSt : String;
    t     : Integer;
begin
  if Pen.Style<>psClear then
  begin
    PrepareShape('Polyline',True,False);

    tmpSt:=' Points="';

    for t:=Low(Points) to High(Points) do
        tmpSt:=tmpSt+PointToStr(Points[t].X,Points[t].Y)+' ';

    Add(tmpSt+'"/>');
  end;
end;

function TXAMLCanvas.InitWindow(DestCanvas: TCanvas;
  A3DOptions: TView3DOptions; ABackColor: TColor; Is3D: Boolean;
  const UserRect: TRect): TRect;
begin
  result:=inherited InitWindow(DestCanvas,A3DOptions,ABackColor,Is3D,UserRect);

  Add('<Canvas Name="'+
            {$IFNDEF TEEOCX}
            IPanel.Name+
            {$ELSE}
            'Chart'+
            {$ENDIF}
            '" Width="'+IntToStr(Bounds.Right-Bounds.Left)+
            '" Height="'+IntToStr(Bounds.Bottom-Bounds.Top)+
            '" Background='+XAMLColor(ABackColor)+
            ' ClipToBounds="True"'+
            ' xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"'+
            ' xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"'+
            '>');

  Pen.OnChange:=ChangedPen;
end;

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

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

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

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

{ TXAMLExportFormat }
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:=TXAMLCanvas.Create(Panel, result);

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

    try
      Panel.Draw(Panel.Canvas.ReferenceCanvas,TeeRect(0,0,Width,Height));

      result.Insert(0,'<!-- Generated by TeeChart Pro Version '+TeeChartVersion+' -->');
    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.