teepdfcanvas.pas

TeeChart7Source 控件

      WriteStringToStream(FCStream,'q'+CRLF);
      if a>b then
      begin
        rat := b/a;
        tr := y*(1.0-rat);
        tmpSt := '1 0 0 ' + FormatFloat('0.000',rat) + ' 0 '+ FormatFloat('0.000',tr);
      end else
      begin
        rat := a/b;
        tr := x*(1.0-rat);
        tmpSt := FormatFloat('0.000',rat)+ ' 0 0 1 '+ FormatFloat('0.000',tr) +  ' 0';
      end;
      FixSeparator(tmpSt);
      tmpSt := tmpSt + ' cm'+CRLF;
      WriteStringToStream(FCStream,tmpSt);
    end;

    { 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 WriteStringToStream(FCStream,PointToStr(x,y)+' m'+CRLF);
    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 WriteStringToStream(FCStream,' h B'+CRLF) else WriteStringToStream(FCStream,' h f'+CRLF)
    else if DrawPie then WriteStringToStream(FCStream,' s'+CRLF)
    else if Not(DrawPie) then WriteStringToStream(FCStream,' S'+CRLF);
    if a<>b then WriteStringToStream(FCStream,'Q'+CRLF);
  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;

procedure TPDFCanvas.InternalDrawImage(sx, sy, tx,ty: double;
  ImageIndex: Integer);
begin
  WriteStringToStream(FCStream,'q ');
  tmpSt := FormatFloat('0.000',sx) + ' 0 0 ' +
    FormatFloat('0.000',sy) + ' ' + FormatFloat('0.000',tx) + ' ' +
    FormatFloat('0.000',ty);
  FixSeparator(tmpSt);
  tmpSt := tmpSt + ' cm /Im'+ IntToStr(ImageIndex)+' Do Q';
  WriteStringToStream(FCStream, tmpSt+CRLF);
end;

procedure TPDFCanvas.SetEmbeddedFonts(const Value: boolean);
begin
  FEmbeddedFonts := Value;
end;

procedure TPDFCanvas.WriteToStream(AStream: TStream);
begin

end;

constructor TPDFCanvas.Create(AChartObject: TPDFChartObject);
begin
  inherited Create;
  FBackMode := cbmTransparent;
  UseBuffer:=False;
  FContents := AChartObject;
  FCStream := FContents.Contents;
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 PDFPage 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 PDFPage do
  try
    SaveToStream(Stream);
  finally
    Free;
  end;
end;

type TTeePanelAccess=class(TCustomTeePanel);

function TPDFExportFormat.PDFPage: TTeePDFPage;
var tmp : TCanvas3D;
begin { return a panel or chart in PDF format into a StringList }
  CheckSize;
  Result := TTeePDFPage.Create;
  Panel.AutoRepaint := False;
  try
    Result.PageWidth := Width;
    Result.PageHeight := Height;

    {$IFNDEF CLR}
    tmp:=TTeePanelAccess(Panel).InternalCanvas;
    TTeePAnelAccess(Panel).InternalCanvas:=nil;
    {$ENDIF}

    Panel.Canvas := TPDFCanvas.Create(Result.ChartObject);
    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;
begin
  inherited Destroy;
end;

function TPDFCanvas.FontProperties(Font: TTeeFont; var FontIndex: Integer): String;
begin
  FontIndex := SelectFont(Font);
  Result := '/F'+ IntToStr(FontIndex) + ' ' +
            IntToStr(Font.Size)+ ' Tf '+
            IntToStr(Font.InterCharSize) + ' Tc ';
end;


{ TFontListEntry }

constructor TTeePDFFontListEntry.Create(AFont: TFont);
begin
  inherited Create;
  FPDFName := PDFFontName(AFont);
  DefineFontData(AFont);
end;

procedure TTeePDFFontListEntry.DefineFontData(AFont: TFont);
var FontInfo: {$IFNDEF CLR}^{$ENDIF}TOutlineTextMetric;
    fnt: HFont;
    m_hdcFont: HDC;
begin
  {$IFNDEF CLR}
  New(FontInfo);
  {$ENDIF}
  try
    fnt := CreateFont(-1000, 0, 0, 0, FW_DONTCARE, 0, 0, 0,
                      {$IFDEF CLX}
                      1
                      {$ELSE}
                      DEFAULT_CHARSET
                      {$ENDIF},
                      OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
                      DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE,
                      {$IFNDEF CLR}PChar{$ENDIF}(AFont.Name));
    m_hdcFont := GetDC(0);
    SelectObject(m_hdcFont, fnt);
    DeleteObject( fnt );
    GetOutlineTextMetrics(m_hdcFont,SizeOf(TOutlineTextMetric),FontInfo);
    With FFontData do
    begin
      DigAspX := FontInfo.otmTextMetrics.tmDigitizedAspectX;
      DigAspY := FontInfo.otmTextMetrics.tmDigitizedAspectY;
      FontBBox := FontInfo.otmrcFontBox;
      FirstChar := Ord(FontInfo.otmTextMetrics.tmFirstChar);
      LastChar := Ord(FontInfo.otmTextMetrics.tmLastChar);
      CapHeight := FontInfo.otmsCapEmHeight;
      Ascent := FontInfo.otmTextMetrics.tmAscent;
      Descent := -FontInfo.otmTextMetrics.tmDescent;
      MaxWidth := FontInfo.otmTextMetrics.tmMaxCharWidth;
      AvgWidth := FontInfo.otmTextMetrics.tmAveCharWidth;
      ItalicAngle := FontInfo.otmItalicAngle;
      GetCharWidth(m_hdcFont,0,255,CharWidths);
    end;
  finally
    {$IFNDEF CLR}
    Dispose(FontInfo);
    {$ENDIF}
  end;
end;

{ TFontList }

function TTeePDFFontList.AddItem(AFont: TFont; AHandle: TTeeCanvasHandle): Integer;
begin
  Result := IFontList.Add(TTeePDFFontListEntry.Create(AFont));
end;

constructor TTeePDFFontList.Create;
begin
  inherited;
  IFontList := TList.Create;
end;

destructor TTeePDFFontList.Destroy;
var i: Integer;
begin
  for i := 0 to IFontList.Count - 1 do TTeePDFFontListEntry(IFontList.Items[i]).Free;
  IFontList.Free;
  inherited Destroy;
end;

function TTeePDFFontList.Find(AFont: TFont): Integer;
var i: Integer;
    tmpName: String;
begin
  Result := -1;
  tmpName := PDFFontName(AFont);
  for i := 0 to IFontList.Count - 1 do
    if tmpName = TTeePDFFontListEntry(IFontList.Items[i]).PDFName then
    begin
      Result := i;
      Break;
    end;
end;

function TTeePDFFontList.GetCount: Integer;
begin
  Result := IFontList.Count;
end;

function TTeePDFFontList.GetFontEntry(Index: Integer): TTeePDFFontListEntry;
begin
  Result := TTeePDFFontListEntry(IFontList.Items[Index]);
end;

function TPDFExportFormat.ChartObject: TPDFChartObject;
var tmp : TCanvas3D;
begin { return a panel or chart in PDF format into a StringList }
  CheckSize;
  Result := TPDFChartObject.Create;
  Panel.AutoRepaint := False;
  try
    
    {$IFNDEF CLR}
    tmp := TTeePanelAccess(Panel).InternalCanvas;
    TTeePAnelAccess(Panel).InternalCanvas := nil;
    {$ENDIF}

    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;

{ TPDFChartObject }

constructor TPDFChartObject.Create;
begin
  inherited Create;
  FFontArray := TTeePDFFontList.Create;
  FImageArray := TTeePDFImageList.Create;
  FContents := TMemoryStream.Create;
end;

destructor TPDFChartObject.Destroy;
begin
  FFontArray.Free;
  FImageArray.Free;
  FContents.Free;
  inherited;
end;

function TPDFChartObject.GetLength: Integer;
begin
  Result := FContents.Size;
end;

procedure TPDFChartObject.SaveToStream(AStream: TStream);
begin
  WriteStringToStream(AStream,'<< /Length '+IntToStr(GetLength)+ ' >>'+CRLF);
  WriteStringToStream(AStream,'stream'+CRLF);
  AStream.CopyFrom(FContents,0);
  WriteStringToStream(AStream,'endstream'+CRLF);
end;

{ TTeePDFPage }

procedure TTeePDFPage.AddToOffset(Offset: Integer);
begin
  OffsetList.Add(FormatIntToString(OffSet, 10));
end;

constructor TTeePDFPage.Create;
begin
  inherited Create;
  IObjCount := 0;
  FChartObject := TPDFChartObject.Create;
  OffsetList := TStringList.Create;
end;

destructor TTeePDFPage.Destroy;
begin