teevmlcanvas.pas

TeeChart7Source 控件

  Calc3DPos(X2,Y2,Z);

  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='+
         VMLColor(Brush.Color)+VmlPen('oval'));
end;

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

Procedure TVMLCanvas.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:'+VMLColorInternal(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 TVMLCanvas.TextOut(X,Y:Integer; const Text:String);
begin
  TextOut3D(x,y,0,Text);
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  Add(result+'>');
end;

Procedure TVMLCanvas.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 TVMLCanvas.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 TVMLCanvas.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 TVMLCanvas.ChangedPen(Sender: TObject);
begin
  IPenStyle:=Pen.Style;
  IPenWidth:=Pen.Width;
end;

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

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

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

{ TVMLExportFormat }
function TVMLExportFormat.Description: String;
begin
  result:=TeeMsg_AsVML;
end;

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

function TVMLExportFormat.FileExtension: String;
begin
  result:='HTM';
end;

function TVMLExportFormat.FileFilter: String;
begin
  result:=TeeMsg_VMLFilter;
end;

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

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

type TTeePanelAccess=class(TCustomTeePanel);

// Returns a panel or chart in VML format into a StringList
function TVMLExportFormat.VML: 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:=TVMLCanvas.Create(result);
    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 TeeSaveToVMLFile( APanel:TCustomTeePanel; const FileName: WideString;
                            AWidth:Integer=0;
                            AHeight: Integer=0);
begin { save panel or chart to filename in VML (html) format }
  with TVMLExportFormat.Create do
  try
    Panel:=APanel;
    Height:=AHeight;
    Width:=AWidth;
    SaveToFile(FileName);
  finally
    Free;
  end;
end;

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