teevmlcanvas.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 697 行 · 第 1/2 页

  Calc3DPos(X2,Y2,Z);

  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    Add('<v:oval style="position:absolute;left:'+IntToStr(X1)+';top:'+IntToStr(Y1)+
        ';height:'+IntToStr(Y2-Y1)+';width:'+IntToStr(X2-X1)+'" fillcolor='+
        VMLColor(Brush.Color)+
         '/>');
  end;
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 FontSize:String;
  begin
    result:=IntToStr(1+((Font.Size-8) div 2));
  end;

  Procedure DoText(AX,AY:Integer);
  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)+
        '; text-color='+VMLColor(Font.Color)+' text-align:left">');

    Add('<font color='+VMLColor(Font.Color)+' face="'+Font.Name+'" size="'+FontSize+'">');

    Add(Text);

    Add('</font>');

    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)
  end;

  DoText(X,Y);
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:Integer);
begin
  Calc3DPos(x,y,z);
  TextOut(X,Y,St);
end;

procedure TVMLCanvas.RotateLabel(x,y:Integer; Const St:String; RotDegree:Integer);
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;

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)+
       '">');
end;

procedure TVMLCanvas.SetTextAlign(Align: TCanvasTextAlign);
begin
  FTextAlign:=Align;
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);

function TVMLExportFormat.VML: TStringList;
var tmp : TCanvas3D;
begin { return a panel or chart in VML format into a StringList }
  CheckSize;
  result:=TStringList.Create;
  Panel.AutoRepaint:=False;
  try
    tmp:=TTeePanelAccess(Panel).InternalCanvas;
    TTeePanelAccess(Panel).InternalCanvas:=nil;
    Panel.Canvas:=TVMLCanvas.Create(result);
    try
      Panel.Draw(Panel.Canvas.ReferenceCanvas,TeeRect(0,0,Width,Height));
      { add html headings }
      result.Insert(0,'<body>');
      result.Insert(0,'<html>');
      result.Add('</body>');
      result.Add('</html>');
    finally
      Panel.Canvas:=tmp;
    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.