{

 This demo opens RTF or RVF file, and saves it to PDF file.
 It uses TRichView and Synopse PDF Engine components:
 http://www.trichview.com
 http://www.synopse.info

 This demo supports:
 - loading page size and margins from RTF and RVF (you can modify them in the
   user interface)
 - links to bookmarks
 It does not support headers, footers, footnotes and endnotes, text boxes.
}

unit uSynosePDFCreator;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Math, RVStyle, PtblRV, RVReport, CRVData, RVRTF, RVFuncs,
  Synpdf, SynCommons;

type
  TPageInfo = record
    PageFormat: TPDFPaperSize;
    PageSize: TSize;
    DocRect: TRect;
  end;

  TSynosePDFCreator = class(TForm)
    btnOpenFile: TButton;
    btnSavePDF: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    rvh: TRVReportHelper;
    gbMargins: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    txtLeft: TEdit;
    txtTop: TEdit;
    txtRight: TEdit;
    txtBottom: TEdit;
    rgPageOrientation: TRadioGroup;
    gbPageSize: TGroupBox;
    Label1: TLabel;
    cmbPageSize: TComboBox;
    Label8: TLabel;
    Label9: TLabel;
    txtWidth: TEdit;
    txtHeight: TEdit;
    procedure btnOpenFileClick(Sender: TObject);
    procedure btnSavePDFClick(Sender: TObject);
    procedure rvhDrawCheckpoint(Sender: TRVReportHelper; RVData: TCustomRVData; ItemNo, X, Y: Integer);
    procedure cmbPageSizeClick(Sender: TObject);
    procedure txtPageSizeChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FChangingPageSize: Boolean;
    FPageInfo: TPageInfo;
    FPdfDoc: TPdfDocumentGDI;
    function GetPixels(edit: TEdit): Integer;
    procedure SetValue(edit: TEdit; Value: TRVLength);
    procedure InitHelper(h: TRVReportHelper);
    procedure CalcPageLayout(Canvas: TCanvas; var PageInfo: TPageInfo);
    procedure rvhDrawHyperlink(Sender: TRVReportHelper; RVData: TCustomRVData; ItemNo: Integer; R: TRect);
    procedure SetPageSize;
    { Private declarations }
  public
    { Public declarations }
    procedure rvfOrRtf2PDF(aSourceFilePath, aDestFilePath: string);
  end;

var
  SynosePDFCreator: TSynosePDFCreator;

implementation

{$R *.dfm}

procedure TSynosePDFCreator.FormCreate(Sender: TObject);
begin
  InitHelper(rvh);
  cmbPageSizeClick(nil);
  rvh.OnDrawCheckpoint := rvhDrawCheckpoint;
  rvh.OnDrawHyperlink := rvhDrawHyperlink;
end;


{------------------------------------------------------------------------------}
{ Loading RTF or RVF file in rvh }
procedure TSynosePDFCreator.btnOpenFileClick(Sender: TObject);
var
  r: Boolean;
begin
  if not OpenDialog1.Execute then
    exit;
  rvh.RichView.Clear;
  case OpenDialog1.FilterIndex of
    1:
      r := rvh.RichView.LoadRTF(OpenDialog1.FileName);
    2:
      r := rvh.RichView.LoadRVF(OpenDialog1.FileName);
  else
    r := False;
  end;
  if not r then
    Application.MessageBox('Error while loading file', 'Error', MB_OK or MB_ICONSTOP);
  SetValue(txtLeft, rvh.RichView.DocParameters.LeftMargin);
  SetValue(txtTop, rvh.RichView.DocParameters.TopMargin);
  SetValue(txtRight, rvh.RichView.DocParameters.RightMargin);
  SetValue(txtBottom, rvh.RichView.DocParameters.BottomMargin);
  rgPageOrientation.ItemIndex := ord(rvh.RichView.DocParameters.Orientation);
  SetValue(txtWidth, rvh.RichView.DocParameters.PageWidth);
  SetValue(txtHeight, rvh.RichView.DocParameters.PageHeight);
  btnSavePDF.Enabled := rvh.RichView.ItemCount > 0;
end;
{------------------------------------------------------------------------------}
{ Assigning default values to ReportHelper }

procedure TSynosePDFCreator.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];
end;

procedure TSynosePDFCreator.rvfOrRtf2PDF(aSourceFilePath, aDestFilePath: string);
var
  i: Integer;
  dpi: Integer;
  r: boolean;
var
  ext: string;
  {....................................................}

  procedure DrawPage(rvh: TRVReportHelper; PageNo: Integer; R: TRect);
  begin
    rvh.DrawPageAt(R.Left, R.Top, i, FPdfDoc.VCLCanvas, True, R.Bottom - R.Top);
  end;
  {....................................................}



begin
//open file in rvf
  rvh.RichView.Clear;
  ext := ExtractFileExt(aSourceFilePath);

  if ext = '.rvf' then
    r := rvh.RichView.LoadRVF(aSourceFilePath)
  else if ext = '.rtf' then
    r := rvh.RichView.LoadRVF(aSourceFilePath)
  else
    r := False;

  if not r then
    raise Exception.Create('Error while loading source file,when converting to pdf');
    //Application.MessageBox('Error while loading file', 'Error', MB_OK or MB_ICONSTOP);
  SetValue(txtLeft, rvh.RichView.DocParameters.LeftMargin);
  SetValue(txtTop, rvh.RichView.DocParameters.TopMargin);
  SetValue(txtRight, rvh.RichView.DocParameters.RightMargin);
  SetValue(txtBottom, rvh.RichView.DocParameters.BottomMargin);
  rgPageOrientation.ItemIndex := ord(rvh.RichView.DocParameters.Orientation);
  SetValue(txtWidth, rvh.RichView.DocParameters.PageWidth);
  SetValue(txtHeight, rvh.RichView.DocParameters.PageHeight);
  btnSavePDF.Enabled := rvh.RichView.ItemCount > 0;
// save file in pdf
  CalcPageLayout(Canvas, FPageInfo);
  dpi := Screen.PixelsPerInch;
  FPdfDoc := TPdfDocumentGDI.Create;
  try
    FPdfDoc.ScreenLogPixels := dpi;
    if TPDFPaperSize(cmbPageSize.ItemIndex) = psUserDefined then
    begin
      FPdfDoc.DefaultPageWidth := Round(FPageInfo.PageSize.cx * 72 / dpi);
      FPdfDoc.DefaultPageHeight := Round(FPageInfo.PageSize.cy * 72 / dpi);
    end;
    FPdfDoc.DefaultPaperSize := TPDFPaperSize(cmbPageSize.ItemIndex);
    FPdfDoc.DefaultPageLandscape := rgPageOrientation.ItemIndex = 1;
    for i := 1 to rvh.PagesCount do
    begin
      FPdfDoc.AddPage;
      DrawPage(rvh, i, FPageInfo.DocRect);
    end;
    if not FPdfDoc.SaveToFile(aDestFilePath) then
      Application.MessageBox('Cannot save PDF', 'Error', MB_OK or MB_ICONSTOP);
  finally
    FPdfDoc.Free;
  end;
end;

{------------------------------------------------------------------------------}
{ This event occurs when drawing an item associated with the checkpoint.
  We save it in PDF as a bookmark }
procedure TSynosePDFCreator.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.DocRect.Top)) * 72 / Screen.PixelsPerInch;
  FPdfDoc.CreateBookMark(BookmarkY + FPageInfo.DocRect.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 TSynosePDFCreator.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.DocRect.Left, FPageInfo.DocRect.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;
{------------------------------------------------------------------------------}
{ Returns distance from edit, converted from mm to pixels }

function TSynosePDFCreator.GetPixels(edit: TEdit): Integer;
var
  mm: Integer;
begin
  mm := StrToIntDef(edit.Text, 0);
  edit.Text := IntToStr(mm);
  Result := rvh.RichView.Style.RVUnitsToPixels(mm, rvuMillimeters);
end;
{------------------------------------------------------------------------------}
{ Sets value defined in rvh.RichView.DocParameters.Units to edit, rounded }

procedure TSynosePDFCreator.SetValue(edit: TEdit; Value: TRVLength);
var
  mm: Integer;
begin
  mm := Round(RV_UnitsToUnits(Value, rvh.RichView.DocParameters.Units, rvuMillimeters));
  edit.Text := IntToStr(mm);
end;
{------------------------------------------------------------------------------}
{ Filling PageInfo - calculating size and position of page and document.
  Also formats rvh. }

procedure TSynosePDFCreator.CalcPageLayout(Canvas: TCanvas; var PageInfo: TPageInfo);
var
  w, h: Integer;
begin
  w := GetPixels(txtWidth);
  h := GetPixels(txtHeight);
  if rgPageOrientation.ItemIndex = 0 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.DocRect.Top := GetPixels(txtTop);
  PageInfo.DocRect.Bottom := PageInfo.PageSize.cy - GetPixels(txtBottom);
  PageInfo.DocRect.Left := GetPixels(txtLeft);
  PageInfo.DocRect.Right := PageInfo.PageSize.cx - GetPixels(txtRight);
  rvh.Init(Canvas, PageInfo.DocRect.Right - PageInfo.DocRect.Left);
  while rvh.FormatNextPage(PageInfo.DocRect.Bottom - PageInfo.DocRect.Top) do
    ;
end;
{------------------------------------------------------------------------------}

const
  PageSizesMM: array[TPDFPaperSize] of TSize = ((
    cx: 210;
    cy: 297
  ), (
    cx: 148;
    cy: 210
  ), (
    cx: 297;
    cy: 420
  ), (
    cx: 216;
    cy: 279
  ), (
    cx: 216;
    cy: 356
  ), (
    cx: 0;
    cy: 0
  ), (
    cx: 0;
    cy: 0
  ), (
    cx: 0;
    cy: 0
  ), (
    cx: 0;
    cy: 0
  ));

{------------------------------------------------------------------------------}
{ Assigning page size according to values in txtWidth and txtHeight to cmbPageSize }
procedure TSynosePDFCreator.SetPageSize;
var
  w, h: Integer;
  i: TPDFPaperSize;
begin

  w := StrToIntDef(txtWidth.Text, 1);
  h := StrToIntDef(txtHeight.Text, 1);
  FChangingPageSize := True;
  try
    for i := Low(TPDFPaperSize) to Pred(High(TPDFPaperSize)) do
      if (w = PageSizesMM[i].cx) and (h = PageSizesMM[i].cy) then
      begin
        cmbPageSize.ItemIndex := ord(i);
        exit;
      end;
    cmbPageSize.ItemIndex := ord(psUserDefined);
  finally
    FChangingPageSize := False;
  end;
end;
{------------------------------------------------------------------------------}
{ Occurs when cmbPageSize is clicked. We change values in
  txtWidth and txtHeight according to the selected item }

procedure TSynosePDFCreator.cmbPageSizeClick(Sender: TObject);
var
  PaperSize: TPDFPaperSize;
begin
  FChangingPageSize := True;
  PaperSize := TPDFPaperSize(cmbPageSize.ItemIndex);
  if PaperSize <> psUserDefined then
  begin
    txtWidth.Text := IntToStr(PageSizesMM[PaperSize].cx);
    txtHeight.Text := IntToStr(PageSizesMM[PaperSize].cy);
  end;
  FChangingPageSize := False;
end;
{------------------------------------------------------------------------------}
{ Occurs when txtWidth or txtHeight is edited. We change cmbPageSize selection
  according to the page size }

procedure TSynosePDFCreator.txtPageSizeChange(Sender: TObject);
begin
  if not FChangingPageSize then
    SetPageSize;
end;
{------------------------------------------------------------------------------}
{ Saving PDF file }

procedure TSynosePDFCreator.btnSavePDFClick(Sender: TObject);
var
  i: Integer;
  dpi: Integer;

  {....................................................}

  procedure DrawPage(rvh: TRVReportHelper; PageNo: Integer; R: TRect);
  begin
    rvh.DrawPageAt(R.Left, R.Top, i, FPdfDoc.VCLCanvas, True, R.Bottom - R.Top);
  end;
  {....................................................}



begin
  if not SaveDialog1.Execute then
    exit;
  CalcPageLayout(Canvas, FPageInfo);
  dpi := Screen.PixelsPerInch;
  FPdfDoc := TPdfDocumentGDI.Create;
  try
    FPdfDoc.ScreenLogPixels := dpi;
    if TPDFPaperSize(cmbPageSize.ItemIndex) = psUserDefined then
    begin
      FPdfDoc.DefaultPageWidth := Round(FPageInfo.PageSize.cx * 72 / dpi);
      FPdfDoc.DefaultPageHeight := Round(FPageInfo.PageSize.cy * 72 / dpi);
    end;
    FPdfDoc.DefaultPaperSize := TPDFPaperSize(cmbPageSize.ItemIndex);
    FPdfDoc.DefaultPageLandscape := rgPageOrientation.ItemIndex = 1;
    for i := 1 to rvh.PagesCount do
    begin
      FPdfDoc.AddPage;
      DrawPage(rvh, i, FPageInfo.DocRect);
    end;
    if not FPdfDoc.SaveToFile(SaveDialog1.FileName) then
      Application.MessageBox('Cannot save PDF', 'Error', MB_OK or MB_ICONSTOP);
  finally
    FPdfDoc.Free;
  end;
end;

end.

