teepdfcanvas.pas

TeeChart7Source 控件

begin
  result:=False;
end;

Procedure TPDFCanvas.SetMonochrome(Value:Boolean);
begin
  { Not implemented }
end;

Function TPDFCanvas.ValidGraphic(Graphic: TGraphic):Boolean;
begin
  result:=(Graphic is TBitmap)
    {$IFNDEF CLR}{$IFNDEF CLX}or (Graphic is TJPEGImage){$ENDIF}{$ENDIF};
end;

procedure TPDFCanvas.StretchDraw(const Rect: TRect; Graphic: TGraphic);
begin
  if ValidGraphic(Graphic) then
    InternalDrawImage( Abs(Rect.Right - Rect.Left),
                       Abs(Rect.Bottom - Rect.Top),
                       Rect.Left,IHeight-Rect.Bottom,SelectImage(Graphic));
end;

procedure TPDFCanvas.Draw(X, Y: Integer; Graphic: TGraphic);
begin
  if ValidGraphic(Graphic) then
    InternalDrawImage(Graphic.Width,Graphic.Height,X,IHeight-Y-Graphic.Height,SelectImage(Graphic));
end;

Function TPDFCanvas.TheBounds:String;
begin
  IWidth := Bounds.Right - Bounds.Left;
  IHeight := Bounds.Bottom - Bounds.Top;
end;

Function TPDFCanvas.PointToStr(X,Y:double):String;
begin
  TranslateVertCoord(Y);
  tmpSt := FormatFloat('0.000',X)+' '+FormatFloat('0.000',Y);
  FixSeparator(tmpSt);
  Result := tmpSt;
end;

Procedure TPDFCanvas.GradientFill( Const Rect:TRect;
                                  StartColor,EndColor:TColor;
                                  Direction:TGradientDirection;
                                  Balance:Integer=50);
begin
  { Not implemented }
end;

procedure TPDFCanvas.FillRect(const Rect: TRect);
begin
  InternalRect(Rect,False,False);
end;

Procedure TPDFCanvas.InternalRect(Const Rect:TRect; UsePen, IsRound:Boolean);
var tmpB,tmpT: double;
begin
  if (Brush.Style<>bsClear) or (UsePen and (Pen.Style<>psClear)) then
  begin
    tmpSt := PenProperties(Pen) + ' ' + BrushProperties(Brush)+ ' ';
    tmpB := Rect.Bottom;
    tmpT := Rect.Top;
    TranslateVertCoord(tmpB);
    TranslateVertCoord(tmpT);
    tmpSt := tmpSt+FormatFloat('0.000',Rect.Left)+' '+ FormatFloat('0.000',tmpB)+ ' ' +
            FormatFloat('0.000',Rect.Right-Rect.Left)+' ' + FormatFloat('0.000',tmpT-tmpB)+' re';
    FixSeparator(tmpSt);
    WriteStringToStream(FCStream,tmpSt);

    if (Brush.Style<>bsClear) then
    begin
      if (Pen.Style<>psClear) then WriteStringToStream(FCStream,' B'+CRLF)
      else WriteStringToStream(FCStream,' f'+CRLF);
    end else WriteStringToStream(FCStream,' S'+CRLF);
  end;
end;

procedure TPDFCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
begin
  EllipseWithZ(X1,Y1,X2,Y2,0);
end;

procedure TPDFCanvas.EllipseWithZ(X1, Y1, X2, Y2, Z: Integer);
var ra,rb,xc,yc: double;
const Bez = 0.552;
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    WriteStringToStream(FCStream,PenProperties(Pen) + ' ' + BrushProperties(Brush)+ ' ');
    Calc3DPos(X1,Y1,Z);
    Calc3DPos(X2,Y2,Z);
    ra := (X2 - X1)*0.5;
    rb := (Y2 - Y1)*0.5;
    xc := (X2 + X1)*0.5;
    yc := (Y2 + Y1)*0.5;
    TranslateVertCoord(yc);
    tmpSt := FormatFloat('0.000',xc+ra)+ ' ' + FormatFloat('0.000',yc)+ ' m ';
    { 4-arc version of drawing circle/ellipse }
    { Q1, Q2, Q3 and Q4 cp}
    tmpSt := tmpSt + InternalBezCurve(xc+ra, yc+Bez*rb, xc+Bez*ra, yc+rb, xc, yc+rb);
    tmpSt := tmpSt + InternalBezCurve(xc-Bez*ra, yc+rb, xc-ra, yc+Bez*rb, xc-ra, yc);
    tmpSt := tmpSt + InternalBezCurve(xc-ra, yc-Bez*rb, xc-Bez*ra, yc-rb, xc, yc-rb);
    tmpSt := tmpSt + InternalBezCurve(xc+Bez*ra, yc-rb, xc+ra, yc-Bez*rb, xc+ra, yc);
    FixSeparator(tmpSt);
    WriteStringToStream(FCStream,tmpSt);
    if (Brush.Style<>bsClear) then
    begin
      if (Pen.Style<>psClear) then WriteStringToStream(FCStream,' B'+CRLF)
      else WriteStringToStream(FCStream,' f'+CRLF);
    end else WriteStringToStream(FCStream,' S'+CRLF);
  end;
end;

procedure TPDFCanvas.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 TPDFCanvas.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 TPDFCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  InternalDrawArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4, True,False);
end;

procedure TPDFCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  InternalDrawArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4, False, True);
end;

procedure TPDFCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  InternalRect(TeeRect(X1,Y1,X2,Y2),True,True);
end;

Procedure TPDFCanvas.TextOut3D(X,Y,Z:Integer; const Text:String);
begin
  RotateLabel3D(X,Y,Z,Text,0);
end;

Procedure TPDFCanvas.TextOut(X,Y:Integer; const Text:String);
begin
  TextOut3D(X,Y,0,Text);
end;

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

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

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

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

procedure TPDFCanvas.RotateLabel3D(x,y,z:Integer; Const St:String; RotDegree:Double);

  Procedure DoText(AX,AY: double; RotRad: double);
  var tw,th: double;
      vcos, vsin : double;
      xc,yc: double;
      FontIndex: Integer;
  begin
    WriteStringToStream(FCStream,PDFColor(Font.Color)+' rg ');
    WriteStringToStream(FCStream,'BT ');
    if Assigned(IFont) then WriteStringToStream(FCStream,FontProperties(IFont,FontIndex)+' ')
    else WriteStringToStream(FCStream,FontProperties(TTeeFont(Font),FontIndex)+' ');

    { Get text width and height }
    th := TextHeight(St);
    if (TextAlign and TA_CENTER)=TA_CENTER then tw := TextWidth(St)*0.5
    else if (TextAlign and TA_RIGHT)=TA_RIGHT then tw := TextWidth(St)
    else tw := 0 ;

    {$IFNDEF LINUX}
    { FIX :
      the system uses 72 Pixelsperinch as a base line figure, most systems are
      96 DPI or if your in large Font Mode then 120 DPI
      So when using the TextWidth/TextHeight of the currently selected font, you get the wrong answer
    }
    tw := tw*72/FContents.FontArray.Items[FontIndex].FontData.DigAspX;
    th := th*72/FContents.FontArray.Items[FontIndex].FontData.DigAspY;
    {$ENDIF}

    TranslateVertCoord(AY);
    { rotation elements }
    vcos := Cos(RotRad);
    vsin := Sin(RotRad);

    { rotated values }
    xc := AX - (tw*vcos-th*vsin);
    yc := AY - (tw*vsin+th*vcos);
    tmpSt := FormatFloat('0.000',vcos)+ ' ' + FormatFloat('0.000',vsin)+ ' '+
                    FormatFloat('0.000',-vsin)+ ' ' + FormatFloat('0.000',vcos)+ ' '+
                    FormatFloat('0.000',xc)+ ' ' + FormatFloat('0.000',yc)+ ' Tm ';

    FixSeparator(tmpSt);
    WriteStringToStream(FCStream,tmpSt);
    WriteStringToStream(FCStream,'('+TextToPDFText(St)+') Tj ');
    WriteStringToStream(FCStream,'ET'+CRLF);
  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, RotDegree*0.01745329);
  end;

  DoText(X,Y, RotDegree*0.01745329);
end;

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

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

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

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

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

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

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

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

Procedure TPDFCanvas.Polygon(const Points: Array of TPoint);
var t: Integer;

begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin

    if (Pen.Style<>psClear) then
      WriteStringToStream(FCStream,PenProperties(Pen)+' ');

    WriteStringToStream(FCStream,PointToStr(Points[0].X,Points[0].Y)+' m'+CRLF);
    for t:=1 to High(Points) do
      WriteStringToStream(FCStream,PointToStr(Points[t].X,Points[t].Y)+' l'+CRLF);
    WriteStringToStream(FCStream,'h ');

    if (Brush.Style<>bsClear) then
    begin
      WriteStringToStream(FCStream,BrushProperties(Brush));
      if (Pen.Style<>psClear) then WriteStringToStream(FCStream,' B'+CRLF)
      else WriteStringToStream(FCStream,' f'+CRLF);
    end else WriteStringToStream(FCStream,' S'+CRLF);
  end;
end;

function TPDFCanvas.InitWindow(DestCanvas: TCanvas;
  A3DOptions: TView3DOptions; ABackColor: TColor; Is3D: Boolean;
  const UserRect: TRect): TRect;
begin
  result:=inherited InitWindow(DestCanvas,A3DOptions,ABackColor,Is3D,UserRect);
  IClipCalled := False;
  TheBounds;
end;

function TPDFCanvas.SelectFont(Font: TFont): Integer;
begin
  Result := FContents.FontArray.Find(Font);
  if Result = -1 then Result := FContents.FontArray.AddItem(Font,Handle);
end;

procedure TPDFCanvas.InternalDrawArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; MoveTo0: boolean; DrawPie: boolean);

var fccwc: double;

    procedure Rotate(var ax,ay: double; Angle: double);
    var tx,ty: double;
        vcos, vsin: double;
    begin
      vcos := Cos(Angle);
      vsin := Sin(Angle);
      tx := ax;
      ty := ay;
      ax := vcos*tx - vsin*ty;
      ay := vsin*tx + vcos*ty;
    end;

    procedure ArcSegment(ax, ay, ra, rb, midtheta, hangle: double; amt0: Integer);
    var ax1,ay1,ax2,ay2,ax3,ay3: double;
        ax0,ay0: double;
        hTheta: double;
        vcos, vsin: double;
    begin
      if ra < rb then SwapDouble(ra,rb);

      htheta := Abs(hangle);
      vcos := Cos(htheta);
      vsin := Sin(htheta);
      ax0 := ra*vcos;
      ay0 := -fccwc*ra*vsin;
      Rotate(ax0,ay0,midtheta);

      if (amt0 = 1) then tmpSt := FormatFloat('0.000',ax+ax0)+ ' ' + FormatFloat('0.000',ay+ay0) + ' m'+CRLF
      else if (amt0 = 0) then tmpSt := FormatFloat('0.000',ax+ax0)+ ' ' + FormatFloat('0.000',ay+ay0) + ' l'+CRLF
      else tmpSt := '';

      ax1 := ra*(4.0 - vcos)/3.0;
      ax2 := ax1;
      ay1 := ra*fccwc *(1.0 - vcos) * (vcos - 3.0) / (3.0*vsin);
      ay2 := -ay1;
      ax3 := ra*vcos;
      ay3 := fccwc*ra*vsin;
      Rotate(ax1, ay1, midtheta);
      Rotate(ax2, ay2, midtheta);
      Rotate(ax3, ay3, midtheta);
      tmpSt := tmpSt+InternalBezCurve(ax+ax1,ay+ay1,ax+ax2,ay+ay2,ax+ax3,ay+ay3);
      FixSeparator(tmpSt);
      WriteStringToStream(FCStream,tmpSt);
  end;

var SegCount,i: Integer;
    CurrAngle, Span : double;
    AngleBump, hBump: double;
    x,y,a,b,StartAngle,EndAngle: double;
    rat,tr: double;
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    WriteStringToStream(FCStream,PenProperties(Pen));
    if (Brush.Style<>bsClear) and (DrawPie) then
      WriteStringToStream(FCStream,' '+ BrushProperties(Brush)+CRLF)
    else WriteStringToStream(FCStream,' ');
    { center pos + radius }
    x := (X1 + X2)*0.5;
    y := (Y1 + Y2)*0.5;
    a := (X2 - X1)*0.5;
    b := (Y2 - Y1)*0.5;

    { this is only approx. algorithm }
    if a <> b then
    begin