teepdfcanvas.pas

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

  AddToOffset(tStream.Size);
  PDF.Seek(0, soFromEnd);
  tStream.SaveToStream(PDF);
end;

procedure TPDFCanvas.DefinePages;
begin
  { Pages part }
  Inc(IObjCount);
  IParentNum := IObjCount;
  tStream.Clear;
  AddString(tStream,IntToStr(IObjCount)+' 0 obj');
  AddString(tStream,'<< /Type /Pages');
  { in between comes only one object i.e. Resource }
  AddString(tStream,'/Kids ['+IntToStr(IObjCount+2)+' 0 R]');
  AddString(tStream,'/Count 1');
  AddString(tStream,'>>');
  AddString(tStream,'endobj');
  AddToOffset(tStream.Size);
  PDF.Seek(0, soFromEnd);
  tStream.SaveToStream(PDF);
end;

procedure TPDFCanvas.DefineXRef;
var i: Integer;
begin
  { finally, XRef part }
  Inc(IObjCount);
  tStream.Clear;
  AddString(tStream,'xref');
  AddString(tStream,'0 '+IntToStr(IObjCount));
  AddString(tStream,'0000000000 65535 f');
  { leave the x ref itself }
  for i:=0 to IObjCount-2 do
    AddString(tStream,ObjectOffsetList.Strings[i]+' 00000 n');
  AddString(tStream,'trailer');
  AddString(tStream,'<< /Size '+IntToStr(IObjCount));
  AddString(tStream,'/Root '+IntToStr(ICatalogNum)+' 0 R');
  AddString(tStream,'/Info 1 0 R');
  AddString(tStream,'>>');
  AddString(tStream,'startxref');
  AddString(tStream,Trim(ObjectOffsetList.Strings[IObjCount-1]));
  PDF.Seek(0, soFromEnd);
  tStream.SaveToStream(PDF);
end;

procedure TPDFCanvas.DefineArray;
var i: Integer;
begin
  { Array part }
  Inc(IObjCount);
  IResourceNum := IObjCount;
  tStream.Clear;
  AddString(tStream,IntToStr(IObjCount)+' 0 obj');
  AddString(tStream,'<< /ProcSet [/PDF /Text /ImageC]');
  AddString(tStream,'/Font << ');
  for i:=0 to FontList.Count-1 do
    AddString(tStream,'/'+PFontEntry(FontList.Items[i]).Name+ ' '+ IntToStr(PFontEntry(FontList.Items[i]).ObjPos)+' 0 R ');
  AddString(tStream,'>>');
  AddString(tStream,'>>');
  AddString(tStream,'endobj');
  AddToOffset(tStream.Size);
  PDF.Seek(0, soFromEnd);
  tStream.SaveToStream(PDF);
end;

procedure TPDFCanvas.DefinePage;
begin
  { Single page part }
  Inc(IObjCount);
  tStream.Clear;
  AddString(tStream,IntToStr(IObjCount)+' 0 obj');
  AddString(tStream,'<< /Type /Page');
  AddString(tStream,'/Parent '+IntToStr(IParentNum)+' 0 R');
  AddString(tStream,'/MediaBox [ 0 0 '+IntToStr(IWidth)+' '+IntToStr(IHeight)+']');
  AddString(tStream,'/Contents 2 0 R');
  AddString(tStream,'/Resources '+IntToStr(IResourceNum)+' 0 R');
  AddString(tStream,'>>');
  AddString(tStream,'endobj');
  AddToOffset(tStream.Size);
  PDF.Seek(0, soFromEnd);
  tStream.SaveToStream(PDF);
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
      { TODO : missing the b<>a case }
      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'+#13+#10
      else if (amt0 = 0) then tmpSt := FormatFloat('0.000',ax+ax0)+ ' ' + FormatFloat('0.000',ay+ay0) + ' l'+#13+#10
      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);
      AddString(sStream,tmpSt);
  end;

var SegCount,i: Integer;
    CurrAngle, Span : double;
    AngleBump, hBump: double;
    x,y,a,b,StartAngle,EndAngle: double;
begin
  if (Brush.Style<>bsClear) or (Pen.Style<>psClear) then
  begin
    AddString(sStream,PenProperties(Pen));
    if (Brush.Style<>bsClear) and (DrawPie) then
      AddString(sStream,BrushProperties(Brush));
    { center pos + radius }
    x := (X1 + X2)*0.5;
    y := (Y1 + Y2)*0.5;
    a := (X2 - X1)*0.5;
    b := (Y2 - Y1)*0.5;
    { StartAngle }
    CurrAngle := Math.ArcTan2(Y-Y3, X3 - X);
    if CurrAngle<0 then CurrAngle:=2.0*Pi+CurrAngle;
    StartAngle := CurrAngle;
    { EndAngle }
    Currangle := Math.ArcTan2(Y-Y4, X4 - X);
    if CurrAngle<=0 then CurrAngle:=2.0*Pi+CurrAngle;
    EndAngle := CurrAngle;


    If DrawPie then AddString(sStream,PointToStr(x,y)+' m');
    TranslateVertCoord(y);
    fccwc := 1.0;
    SegCount := 1;
    Span := EndAngle - StartAngle;
    if EndAngle < StartAngle then fccwc := -1.0;
    while (Abs(Span)/SegCount > Pi*0.5) do Inc(SegCount);

    AngleBump := Span/SegCount;
    hBump := 0.5*AngleBump;
    CurrAngle := StartAngle + hBump;
    for i := 0 to SegCount -1 do
    begin
      if i = 0 then ArcSegment(x,y,a,b,CurrAngle,hBump,Integer(MoveTo0))
      else ArcSegment(x,y,a,b,CurrAngle,hBump,-1);
      CurrAngle := CurrAngle + AngleBump;
    end;

    if (Brush.Style<>bsClear) and (DrawPie) then
      if (Pen.Style<>psClear) then AddString(sStream,'h B') else AddString(sStream,'h f')
    else if DrawPie then AddString(sStream,'s')
    else if Not(DrawPie) then AddString(sStream,'S');
  end;
end;

{ Transform ( , ) and \ characters}
function TPDFCanvas.TextToPDFText(AText: String): String;
begin
  AText := StringReplace(AText,'\','\\',[rfReplaceAll,rfIgnoreCase]);
  AText := StringReplace(AText,'(','\(',[rfReplaceAll,rfIgnoreCase]);
  AText := StringReplace(AText,')','\)',[rfReplaceAll,rfIgnoreCase]);
  Result := AText;
end;

function TPDFCanvas.TextHeight(const St: String): Integer;
begin
  Result := inherited TextHeight(St);
end;

function TPDFCanvas.TextWidth(const St: String): Integer;
begin
  Result := inherited TextWidth(St);
end;

{ TPDFExportFormat }
function TPDFExportFormat.Description: String;
begin
  result:=TeeMsg_AsPDF;
end;

function TPDFExportFormat.FileExtension: String;
begin
  result:='pdf';
end;

function TPDFExportFormat.FileFilter: String;
begin
  result:=TeeMsg_PDFFilter;
end;

procedure TPDFExportFormat.DoCopyToClipboard;
var
  buf: PChar;
  buflen : Integer;
begin
  With PDFList do
  try
    bufLen := Size;
    Position := 0;
    buf := AllocMem(buflen+1);
    try
      Read(buf^,buflen+1);
      ClipBoard.AsText:=buf; // SetTextBuf(buf);
    finally
      FreeMem(buf);
    end;
  finally
    Free;
  end;
end;

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

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

type TTeePanelAccess=class(TCustomTeePanel);

function TPDFExportFormat.PDFList: TMemoryStream;
var tmp : TCanvas3D;
begin { return a panel or chart in PDF format into a StringList }
  CheckSize;
  result:=TMemoryStream.Create;
  Panel.AutoRepaint:=False;
  try
    tmp:=TTeePanelAccess(Panel).InternalCanvas;
    TTeePanelAccess(Panel).InternalCanvas:=nil;
    Panel.Canvas:=TPDFCanvas.Create(Result);
    try
      Panel.Draw(Panel.Canvas.ReferenceCanvas,TeeRect(0,0,Width,Height));
    finally
      Panel.Canvas:=tmp;
    end;
  finally
    Panel.AutoRepaint:=True;
  end;
end;

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

procedure TPDFCanvas.TranslateVertCoord(var Y: double);
begin
  { vertical coordinate is reversed in PDF !! }
  Y := IHeight - Y;
end;

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

function TPDFCanvas.PenProperties(Pen: TPen): String;
begin
  Result := PDFColor(Pen.Color)+ ' RG ' +
            IntToStr(Pen.Width)+' w ' +
            SetPenStyle(Pen.Style);
end;

function TPDFCanvas.BrushProperties(Brush: TBrush): String;
begin
  Result := PDFColor(Brush.Color)+' rg';
end;

destructor TPDFCanvas.Destroy;
var i: Integer;
begin
  tStream.Free;
  sStream.Free;
  fStream.Free;
  ObjectOffsetList.Free;
  for i := 0 to FontList.Count -1 do
  begin
    FontEntry := FontList.Items[i];
    Dispose(FontEntry);
  end;
  FontList.Free;
  inherited Destroy;
end;

procedure TPDFCanvas.DefineHeader;
begin
  PDF.Clear;
  AddString(PDF,'%PDF-1.4');
  AddToOffset(PDF.Size);
  { Document info }
  Inc(IObjCount);
  tStream.Clear;
  AddString(tStream,IntToStr(IObjCount)+' 0 obj');
  AddString(tStream,'<<');
  AddString(tStream,'/Creator ('+TeeMsg_Version+')');
  AddString(tStream,'/Producer ('+TeeMsg_Version+')');
  AddString(tStream,'/CreationDate (D:'+FormatDateTime('YYYYMMDDHHmmSS',Now)+')');
  AddString(tStream,'/ModDate ()');
  AddString(tStream,'/Keywords ()');
  AddString(tStream,'/Title (TChart Export)');
  AddString(tStream,'>>');
  AddString(tStream,'endobj');
  AddToOffset(tStream.Size);
  PDF.Seek(0, soFromEnd);
  tStream.SaveToStream(PDF);
end;

procedure TPDFCanvas.EndStream;
var TotalSize: Integer;
begin
  sStream.SaveToStream(tStream);
  sStream.Clear;
  AddString(tStream,'endstream');
  AddString(tStream,'endobj');
  IEndSize := 6;
  AddToOffset(tStream.Size);
  PDF.Seek(0, soFromEnd);
  tStream.SaveToStream(PDF);

  TOtalSize := tStream.Size-IStartSize-IEndSize-Length('stream')-Length('endstream')-6;
  Inc(IObjCount);
  tStream.Clear;
  AddString(tStream,IntToStr(IObjCount)+' 0 obj');
  AddString(tStream,IntToStr(TotalSize));
  AddString(tStream,'endobj');
  AddToOffset(tStream.Size);
  PDF.Seek(0, soFromEnd);
  tStream.SaveToStream(PDF);
end;

procedure TPDFCanvas.StartStream;
begin
  Inc(IObjCount);
  tStream.Clear;
  AddString(tStream,IntToStr(IObjCount)+' 0 obj');
  AddString(tStream,'<< /Length '+IntToStr(IObjCount+1)+' 0 R >>');
  IStartSize:= tStream.Size;
  AddString(tStream,'stream');
  sStream.Clear;
end;

procedure TPDFCanvas.AddToOffset(Offset: Integer);
var i,j: Integer;
  Result: String;
begin
  ObjectOffset := ObjectOffset+Offset;
  tmpSt := IntToStr(ObjectOffset);
  i := Length(tmpSt);
  Result:='';
  for j:= 1 to 10-i do
    Result := Result+'0';
  Result := Result+tmpSt;
  ObjectOffsetList.Add(Trim(Result));
end;

function TPDFCanvas.FontProperties(Font: TTeeFont; var FontIndex: Integer): String;
begin
  FontIndex := SelectFont(Font);
  Result := '/'+PFontEntry(FontList.Items[FontIndex]).Name+ ' ' +
            IntToStr(Font.InterCharSize) + ' Tc '
            +IntToStr(Font.Size)+' Tf';
end;

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