unit SynRTF2PDF;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, SynPdf, RVReport, CRVData;

const
  PageSizesMM: array [TPDFPaperSize] of TSize =
    ((cx:210; cy:297),  // psA4
     (cx:148; cy:210),  // psA5
     (cx:297; cy:420),  // psA3
     (cx:420; cy:594),  // psA2
     (cx:594; cy:841),  // psA1
     (cx:841; cy:1189), // psA0,
     (cx:216; cy:279),  // psLetter
     (cx:216; cy:356),  // psLegal
     (cx:0; cy:0)       // psUserDefined
     );

type
  TPageInfo = record
    PageFormat: TPDFPaperSize;
    PageSize: TSize;
    PaperSize: TPDFPaperSize;
    Doc, Header, Footer: TRect;
  end;

procedure InitHelper(h: TRVReportHelper);
function ConvertRTF2PDF(Canvas: TCanvas; const RTFFile, PDFFile: string): boolean;

implementation

uses SynCommons, RVStyle, RVFuncs, Forms, Math, Printers;

type
  TRVReportEvents = class
    FPageInfo: TPageInfo;
    FPdfDoc: TPdfDocumentGDI;
    constructor Create(PageInfo: TPageInfo; PdfDoc: TPdfDocumentGDI);
    procedure rvhDrawCheckpoint(Sender: TRVReportHelper;
      RVData: TCustomRVData; ItemNo, X, Y: Integer);
    procedure rvhDrawHyperlink(Sender: TRVReportHelper;
      RVData: TCustomRVData; ItemNo: Integer; R: TRect);
  end;

procedure InitHelper(h: TRVReportHelper);
begin
  { SynPDF handles h.MetafileCompatibility = False mode pretty well.
    However, if False, it calculates character positions itself, and they
    may be slightly different.
    If True, all characters are positioned by TRichView }
  h.MetafileCompatibility := True;
  h.RichView.Style := TRVStyle.Create(h);
  h.RichView.RTFReadProperties.TextStyleMode := rvrsAddIfNeeded;
  h.RichView.RTFReadProperties.ParaStyleMode := rvrsAddIfNeeded;
  h.RichView.LeftMargin := 0;
  h.RichView.TopMargin := 0;
  h.RichView.RightMargin := 0;
  h.RichView.BottomMargin := 0;
  h.RichView.RVFOptions :=
    [rvfoIgnoreUnknownPicFmt,
    rvfoIgnoreUnknownCtrls,
    rvfoIgnoreUnknownCtrlProperties,
    rvfoConvUnknownStylesToZero,
    rvfoConvLargeImageIdxToZero,
    rvfoLoadBack,
    rvfoLoadDocProperties];
  h.RichView.Clear;
  h.RichView.RTFReadProperties.ReadDocParameters := True
end;

constructor TRVReportEvents.Create(PageInfo: TPageInfo; PdfDoc: TPdfDocumentGDI);
begin
  FPageInfo := PageInfo;
  FPdfDoc := PdfDoc
end;

{ This event occurs when drawing an item associated with the checkpoint.
  We save it in PDF as a bookmark }
procedure TRVReportEvents.rvhDrawCheckpoint(Sender: TRVReportHelper;
  RVData: TCustomRVData; ItemNo, X, Y: Integer);
var CheckpointData: TCheckpointData;
    CPTag: TRVTag;
    CPName: String;
    RE: Boolean;
    BookmarkY: Single;
begin
  CheckpointData := RVData.GetItemCheckpoint(ItemNo);
  RVData.GetCheckpointInfo(CheckpointData, CPTag, CPName, RE);
  BookmarkY := (FPageInfo.PageSize.cy - (Y + FPageInfo.Doc.Top)) *
    72 / Screen.PixelsPerInch;
  FPdfDoc.CreateBookMark(BookmarkY + FPageInfo.Doc.Top, StringToUTF8(CPName))
end;

{------------------------------------------------------------------------------}
{ This event occurs when drawing a hyperlink.
  We use it to add a link to bookmark.
  The current version of SynPDF does not support links to URL }
procedure TRVReportEvents.rvhDrawHyperlink(Sender: TRVReportHelper;
  RVData: TCustomRVData; ItemNo: Integer; R: TRect);
var
  Target: String;
  PdfRect: TPdfRect;
  dpi: Integer;
begin
  try
    Target := RVData.GetItemTag(ItemNo);
    if (Target<>'') and (Target[1] = '#') then
    begin
      OffsetRect(R, FPageInfo.Doc.Left, FPageInfo.Doc.Top);
      dpi := Screen.PixelsPerInch;
      PdfRect.Left := R.Left * 72 / dpi;
      PdfRect.Top := (FPageInfo.PageSize.cy - R.Top) * 72 / dpi;
      PdfRect.Right := R.Right * 72 / dpi;
      PdfRect.Bottom := (FPageInfo.PageSize.cy - R.Bottom) * 72 / dpi;
      FPdfDoc.CreateLink(PdfRect, StringToUTF8(Copy(Target, 2, MaxInt)))
    end
  except
  end
end;

{------------------------------------------------------------------------------}
// Convert to unit
function GetValue(rvh: TRVReportHelper; Value: TRVLength;
  NewUnits: TRVUnits = rvuPixels): Integer;
begin
  Result := Round(RV_UnitsToUnits(Value,
    rvh.RichView.DocParameters.Units, NewUnits))
end;

// Converting mm to pixels
function MMToPixels(mm, ppi: Integer): Integer;
begin
  Result := Round(mm*5*ppi/127)
end;

function ConvertRTF2PDF(Canvas: TCanvas; const RTFFile, PDFFile: string): boolean;
var
  rvh: TRVReportHelper;
  rvhHeader: TRVReportHelper;
  rvhFooter: TRVReportHelper;
  PdfDoc: TPdfDocumentGDI;
  events: TRVReportEvents;
  PageInfo: TPageInfo;
  HeaderYMM, FooterYMM: Integer;
  ppix,ppiy: Integer;
  i: Integer;
  dpi: Integer;

  {....................................................}
  procedure CalcPageLayout;
  var
    w, h, i: Integer;
  begin
    ppix := GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
    ppiy := GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
    ////////////////////////////////////////////
    w := GetValue(rvh, rvh.RichView.DocParameters.PageWidth, rvuMillimeters);
    h := GetValue(rvh, rvh.RichView.DocParameters.PageHeight, rvuMillimeters);
    PageInfo.PaperSize := psUserDefined;
    for i := Ord(Low(TPDFPaperSize)) to Ord(High(TPDFPaperSize)) do
      if ((w = PageSizesMM[TPDFPaperSize(i)].cx) and (h = PageSizesMM[TPDFPaperSize(i)].cy))
        or ((h = PageSizesMM[TPDFPaperSize(i)].cx) and (w = PageSizesMM[TPDFPaperSize(i)].cy))
      then begin
        PageInfo.PaperSize := TPDFPaperSize(i);
        break
      end;
    //////////////////////////////////////////
    w := GetValue(rvh, rvh.RichView.DocParameters.PageWidth);
    h := GetValue(rvh, rvh.RichView.DocParameters.PageHeight);
    if rvh.RichView.DocParameters.Orientation = poPortrait then begin
      PageInfo.PageSize.cx := Min(w, h);
      PageInfo.PageSize.cy := Max(w, h)
    end else begin
      PageInfo.PageSize.cx := Max(w, h);
      PageInfo.PageSize.cy := Min(w, h)
    end;
    PageInfo.Doc.Top   := GetValue(rvh, rvh.RichView.DocParameters.TopMargin);
    PageInfo.Doc.Bottom := PageInfo.PageSize.cy-
      GetValue(rvh, rvh.RichView.DocParameters.BottomMargin);
    PageInfo.Doc.Left  := GetValue(rvh, rvh.RichView.DocParameters.LeftMargin);
    PageInfo.Doc.Right := PageInfo.PageSize.cx-
      GetValue(rvh, rvh.RichView.DocParameters.RightMargin);
    ////////////////////////////////////
    HeaderYMM := rvh.RichView.RTFReadProperties.HeaderYMM;
    FooterYMM := rvh.RichView.RTFReadProperties.FooterYMM;
    if rvhHeader.RichView.ItemCount>0 then begin
      PageInfo.Header.Left  := PageInfo.Doc.Left;
      PageInfo.Header.Right := PageInfo.Doc.Right;
      rvhHeader.Init(Canvas, PageInfo.Header.Right-PageInfo.Header.Left);
      rvhHeader.FormatNextPage($FFFFFFF);
      PageInfo.Header.Top := MMToPixels(HeaderYMM, ppiy);
      //PageInfo.Header.Top := PageInfo.Doc.Top;
      PageInfo.Header.Bottom := PageInfo.Header.Top+rvhHeader.GetLastPageHeight;
      if PageInfo.Header.Bottom>PageInfo.Doc.Top then
        PageInfo.Doc.Top := PageInfo.Header.Bottom
    end;
    if rvhFooter.RichView.ItemCount>0 then begin
      PageInfo.Footer.Left  := PageInfo.Doc.Left;
      PageInfo.Footer.Right := PageInfo.Doc.Right;
      rvhFooter.Init(Canvas, PageInfo.Header.Right-PageInfo.Header.Left);
      rvhFooter.FormatNextPage($FFFFFFF);
      PageInfo.Footer.Bottom := PageInfo.PageSize.cy-MMToPixels(FooterYMM, ppiy);
      //PageInfo.Footer.Bottom := PageInfo.Doc.Bottom;
      PageInfo.Footer.Top := PageInfo.Footer.Bottom-rvhFooter.GetLastPageHeight;
      if PageInfo.Footer.Top<PageInfo.Doc.Bottom then
        PageInfo.Doc.Bottom := PageInfo.Footer.Top
    end;
    ////////////////////////////////////
    rvh.Init(Canvas, PageInfo.Doc.Right-PageInfo.Doc.Left);
    while rvh.FormatNextPage(PageInfo.Doc.Bottom-PageInfo.Doc.Top) do;
  end;
  {....................................................}

  {....................................................}
  procedure DrawPage;
  begin
    rvh.DrawPageAt(PageInfo.Doc.Left, PageInfo.Doc.Top, i, PdfDoc.VCLCanvas, True,
      PageInfo.Doc.Bottom - PageInfo.Doc.Top);
    ///////////////////////////////////////
    if rvhHeader.RichView.ItemCount>0 then
      rvhHeader.DrawPageAt(PageInfo.Header.Left, PageInfo.Header.Top, 1, PdfDoc.VCLCanvas, True,
      PageInfo.Header.Bottom-PageInfo.Header.Top);
    if rvhFooter.RichView.ItemCount>0 then
      rvhFooter.DrawPageAt(PageInfo.Footer.Left, PageInfo.Footer.Top, 1, PdfDoc.VCLCanvas, True,
        PageInfo.Footer.Bottom-PageInfo.Footer.Top)
  end;
  {....................................................}

begin
  Result := False;
  rvh := TRVReportHelper.Create(nil);
  rvhHeader := TRVReportHelper.Create(nil);
  rvhFooter := TRVReportHelper.Create(nil);
  try
    InitHelper(rvh);
    InitHelper(rvhHeader);
    InitHelper(rvhFooter);
    PdfDoc := TPdfDocumentGDI.Create;
    try
      events := TRVReportEvents.Create(PageInfo, PdfDoc);
      try
        rvh.OnDrawCheckpoint := events.rvhDrawCheckpoint;
        rvh.OnDrawHyperlink := events.rvhDrawHyperlink;
        rvh.RichView.RTFReadProperties.SetHeader(rvhHeader.RichView.RVData);
        rvh.RichView.RTFReadProperties.SetFooter(rvhFooter.RichView.RVData);

        if not rvh.RichView.LoadRTF(RTFFile) then
          Exit;
        CalcPageLayout;

        dpi := Screen.PixelsPerInch;
        PdfDoc.ScreenLogPixels := dpi;
        if PageInfo.PaperSize = psUserDefined then begin
          PdfDoc.DefaultPageWidth :=  Round(PageInfo.PageSize.cx * 72 / dpi);
          PdfDoc.DefaultPageHeight := Round(PageInfo.PageSize.cy * 72 / dpi)
        end;
        PdfDoc.DefaultPaperSize := PageInfo.PaperSize;
        PdfDoc.DefaultPageLandscape := rvh.RichView.DocParameters.Orientation = poLandscape;
        for i := 1 to rvh.PagesCount do begin
          PdfDoc.AddPage;
          DrawPage
        end;

        Result := PdfDoc.SaveToFile(PDFFile)
      finally
        events.Free
      end
    finally
      PdfDoc.Free
    end
  finally
    rvhFooter.Free;
    rvhHeader.Free;
    rvh.Free
  end
end;

end.