teepscanvas.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

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

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

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

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

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

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

procedure TEPSCanvas.RotateLabel3D(x,y,z:Integer; Const St:String; RotDegree:Double);
begin
  Calc3DPos(x,y,z);
  Add('gs '+PointToStr(x,y) + ' tr ' + IntToStr(Round(RotDegree))+ ' rot');
  TextOut(0,Self.Bounds.Bottom,St);
  Add('gr');
end;

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

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

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

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

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

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

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

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

Procedure TEPSCanvas.Polygon(const Points: Array of TPoint);

  Procedure AddPoly;
  var t     : Integer;
  begin
    Add('np '+ PointToStr(Points[0].X,Points[0].Y)+' m');
    for t:=1 to High(Points) do
      Add(PointToStr(Points[t].X,Points[t].Y)+' l');
    Add('cp');
  end;

begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    if (Brush.Style<>bsClear) then
    begin
      Add('gs ' +BrushProperties(Brush));
      AddPoly;
      Add('fi gr');
    end;

    if (Pen.Style<>psClear) then
    begin
      tmpStr :='gs '+ PenProperties(Pen);
      Add(tmpStr);
      AddPoly;
      Add('st gr');
    end;
  end;
end;

function TEPSCanvas.InitWindow(DestCanvas: TCanvas;
  A3DOptions: TView3DOptions; ABackColor: TColor; Is3D: Boolean;
  const UserRect: TRect): TRect;
begin
  result:=inherited InitWindow(DestCanvas,A3DOptions,ABackColor,Is3D,UserRect);
  Add('%!PS-Adobe-3.0 EPSF-3.0');
  Add(TheBounds); { bounding box }
  Add('%%Creator: '+TeeMsg_Version);
  Add('%%LanguageLevel: 1');
  Add('%%EndComments');
  Add('/bd{bind def} bind def /ld{load def}bd /ed{exch def}bd /xd{cvx def}bd');
  Add('/np/newpath ld /cp/closepath ld /m/moveto ld /l/lineto ld /rm/rmoveto ld'
      + '/rl/rlineto ld');
  Add('/rot/rotate ld /sc/scale ld /tr/translate ld');
  Add('/cpt/currentpoint ld');
  Add('/sw/setlinewidth ld /sd/setdash ld /rgb/setrgbcolor ld');
  Add('/gs/gsave ld /gr/grestore ld');
  Add('/st/stroke ld /fi/fill ld /s/show ld');
  Add('/ltext{cpt st m s}def ');
  Add('/rtext{cpt st m dup stringwidth pop neg 0 rm s} def');
  Add('/ctext{cpt st m dup stringwidth pop -2 div 0 rm s} def');
  Add('/ellipsedict 8 dict def');
  Add('ellipsedict /mtrx matrix put');
  Add('/ellipse');
  Add('{ ellipsedict begin');
  Add('  np');
  Add('   /endangle exch def');
  Add('   /startangle exch def');
  Add('   /yrad exch def');
  Add('   /xrad exch def');
  Add('   /y exch def');
  Add('   /x exch def');
  Add('  /savematrix mtrx currentmatrix def');
  Add('  x y tr xrad yrad sc');
  Add('  0 0 1 startangle endangle arc');
  Add('  savematrix setmatrix');
  Add('  end');
  Add('} def');
  Add('/piedict 8 dict def');
  Add('piedict /mtrx matrix put');
  Add('/pie');
  Add('{ piedict begin');
  Add('  np');
  Add('   /endangle exch def');
  Add('   /startangle exch def');
  Add('   /yrad exch def');
  Add('   /xrad exch def');
  Add('   /y exch def');
  Add('   /x exch def');
  Add('  /savematrix mtrx currentmatrix def');
  Add('  x y tr xrad yrad sc');
  Add('  newpath');
  Add('  0 0 m');
  Add('  0 0 1 startangle endangle arc');
  Add('  closepath');
  Add('  savematrix setmatrix');
  Add('  end');
  Add('} def');
  Add('%%EndProlog');
  Add('gs');
  Add('np');
end;

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

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

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

function TEPSExportFormat.FileExtension: String;
begin
  result:='eps';
end;

function TEPSExportFormat.FileFilter: String;
begin
  result:=TeeMsg_PSFilter;
end;

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

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

{$IFNDEF CLR}
type
  TTeePanelAccess=class(TCustomTeePanel);
{$ENDIF}

// return a panel or chart in PS format into a StringList }
function TEPSExportFormat.EPSList: TStringList;
var tmp : TCanvas3D;
begin
  CheckSize;
  result:=TStringList.Create;
  Panel.AutoRepaint:=False;
  try

    // Protected across assemblies
    tmp:={$IFNDEF CLR}TTeePanelAccess{$ENDIF}(Panel).InternalCanvas;
    {$IFNDEF CLR}TTeePanelAccess{$ENDIF}(Panel).InternalCanvas:=nil;

    Panel.Canvas:=TEPSCanvas.Create(Result);

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

    try
      Panel.Draw(Panel.Canvas.ReferenceCanvas,TeeRect(0,0,Width,Height));
    finally
      Panel.Canvas:=tmp;
    end;
  finally
    Panel.AutoRepaint:=True;
  end;
end;

procedure TeeSaveToPSFile( APanel:TCustomTeePanel; const FileName: WideString;
                            AWidth:Integer=0;
                            AHeight: Integer=0);
begin { save panel or chart to filename in EPS (PostScript) format }
  with TEPSExportFormat.Create do
  try
    Panel:=APanel;
    Height:=AHeight;
    Width:=AWidth;
    SaveToFile(FileName);
  finally
    Free;
  end;
end;

procedure TEPSCanvas.TranslateVertCoord(var Y: Integer);
begin
  { vertical coordinate is reversed in PS !! }
  Y := (Self.Bounds.Bottom - Self.Bounds.Top)  - Y;
end;

function TEPSCanvas.SetPenStyle(PenStyle: TPenStyle): String;
begin
  case PenStyle of
    psSolid : Result := '[] 0 sd';
    psDash : Result := '[3] 0 sd';
    psDot : Result := '[2] 1 sd';
    {
    psDashDot : Result :=
    psDashDotDot : Result :=
    }
   else Result := '';
  end;
end;

procedure TEPSCanvas.InternalArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer;
  Pie: Boolean);

var CenterX, CenterY: Integer;
    StartAngle, EndAngle: String;
    Ra,Rb: String;

    procedure DrawPie;
    begin
      Add(IntToStr(CenterX) + ' '+IntToStr(CenterY) + ' ' +
          Ra + ' ' + Rb + ' '+StartAngle+' ' +
          EndAngle+' pie') ;
    end;

    procedure DrawArc;
    begin
      Add(IntToStr(CenterX) + ' '+IntToStr(CenterY) + ' ' +
          Ra + ' ' + Rb + ' '+StartAngle+' ' +
          EndAngle+' ellipse') ;
    end;

var Theta: double;
const HalfDivPi = 57.29577951;

begin
  if ((Brush.Style<>bsClear) or (Pen.Style<>psClear)) then
  begin
    CenterX := (X1 + X2) div 2;
    CenterY := (Y1 + Y2) div 2;
    { StartAngle }
    Theta := Math.ArcTan2(CenterY-Y3, X3 - CenterX);
    if Theta<0 then Theta:=2.0*Pi+Theta;
    Theta := Theta*HalfDivPi;
    StartAngle := FloatToStr(Theta);
    FixSeparator(StartAngle);
    { EndAngle }
    Theta := Math.ArcTan2(CenterY-Y4, X4 - CenterX);
    if Theta<0 then Theta:=2.0*Pi+Theta;
    Theta := Theta*HalfDivPi;
    if Theta=0 then Theta:=361;
    EndAngle := FloatToStr(Theta);
    FixSeparator(EndAngle);
    TranslateVertCoord(CenterY);
    { radius }
    Ra := FormatFloat('0.00',(X2-X1)*0.5);
    FixSeparator(Ra);
    Rb := FormatFloat('0.00',(Y2-Y1)*0.5);
    FixSeparator(Rb);
    If Pie then
    begin
      if (Brush.Style<>bsClear) then
      begin
        Add('gs ' + BrushProperties(Brush));
        DrawPie;
        Add('fi gr');
      end;
      if (Pen.Style<>psClear) then
      begin
        Add('gs ' + PenProperties(Pen));
        DrawPie;
        Add('st gr');
      end;
    end else if (Pen.Style<>psClear) then
    begin
      Add('gs ' + PenProperties(Pen));
      DrawArc;
      Add('st gr');
    end;
  end;
end;

function TEPSCanvas.PenProperties(Pen: TPen): String;
begin
  tmpStr := PSColor(Pen.Color) + ' ' + SetPenStyle(Pen.Style)
            + ' ' + IntToStr(Pen.Width)+' sw';
  Result := tmpStr;
end;

function TEPSCanvas.BrushProperties(Brush: TBrush): String;
begin
  tmpStr := PsColor(Brush.Color);
  Result := tmpStr;
end;

function TEPSCanvas.TextToPSText(AText: String): String;
begin
  AText := StringReplace(AText,'\','\\',[rfReplaceAll,rfIgnoreCase]);
  AText := StringReplace(AText,'(','\(',[rfReplaceAll,rfIgnoreCase]);
  AText := StringReplace(AText,')','\)',[rfReplaceAll,rfIgnoreCase]);
  Result := AText;
end;

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