mORMot Open Source

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,206

Website

Print Preview and PDF generation from any TRichEdit component content

I've added a dedicated method to our open source report engine, in order to append a richedit content to any report.

Here is a resulting report, with some TRichEdit content in the middle of some other lines:
http://synopse.info/files/pdf/pdfrichedit.pdf

Here is how this report was created from code, and a RichEdit component on screen:

procedure TForm1.btnPDFClick(Sender: TObject);
begin
  with TGDIPages.Create(self) do
  try
    Caption := 'SynPDF RichEdit Print Preview & PDF Creation';
    BeginDoc;
    SaveLayout;
    Font.Size := 9;
    AddTextToHeaderAt(Caption,LeftMargin);
    TextAlign := taRight;
    AddTextToHeader(DateTimeToStr(Now));
    AddLineToHeader(true);
    TextAlign := taLeft;
    AddLineToFooter(true);
    AddPagesToFooterAt('Page %d/%d',LeftMargin);
    TextAlign := taRight;
    AddTextToFooterAt('-=- Test Right click on the report then "Export as PDF" -=-',RightMarginPos);
    RestoreSavedLayout;
    DrawTitle('Rich Edit Content',true);
    AppendRichEdit(RichEdit.Handle);
    DrawTitle('Last page content',true);
    NewHalfLine;
    DrawText('We are also able '+
      'to know at where Y position the RichEdit content was finished printing....'#13+
      'Therefore, any further writing to the report continue to the same page.');
    ExportPDF(ChangeFileExt(paramstr(0),'.pdf'),true,false);
    ShowPreviewForm;
  finally
    Free;
  end;
end;

With these units, you have:
1) include RichEdit content to any report
2) print preview of your reports
3) pdf export of your reports

You can download the source code of this tool from
http://synopse.info/files/pdf/pdfrichedit.zip

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,206

Website

Re: Print Preview and PDF generation from any TRichEdit component content

Here you could find some details about how to create reports from code, i.e. use TGDIPages component:

http://synopse.info/forum/viewtopic.php?id=41

Now you can add TRichEdit content to any report.

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,206

Website

Re: Print Preview and PDF generation from any TRichEdit component content

Someone from closed-source software compared their 349 $ product with our open source units.
If you want " One-year Software Assurance (SA) includes at least one major upgrade. " - please add 105 $.
Then include VAT.
And pay $ 542.63 (i.e. € 432.82) for just one part of our framework (aka Report generation and PDF export)...

See https://forums.embarcadero.com/thread.j … eID=265103

I'm some kind of proud!

reddwarf

Member

Registered: 2010-06-28

Posts: 40

Website

Re: Print Preview and PDF generation from any TRichEdit component content

ok, let me be a little bit useful again... maybe i should have posted this code earlier... i have found some code on the internet how to paint rich text on canvas. but it was buggy so i modified it heavily. i also added more functionality to that. the best one is the calculation of actual height of the printed rtf text [you miss ]. it is possible to paint rich text on more pages (always use the result value for the next "FromChar" parameter).

info for ab: i did test neither your new code, nor your rtf text drawing. sorry, no time, a lot of work so my example was compiled with your 1.8.0? version [maybe 1 month old ]... but it works pretty fine for me.

there are some other functions you can just omit if you don't need them.

+ it works with TTntRichEdit, if you wish the normal TRichEdit, just rename everything...

ENJOY:

unit PrintRichText:

unit PrintRichText;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, TntComCtrls, TntControls, TntSysUtils;

type
  TPrintRichEdit = class helper for TTntRichEdit
  private
    function GetRawRTF: String;
    procedure SetRawRTF(const Value: String);
  public
    function DrawTo(ACanvas: TCanvas; aRect: TRect;
      DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint;

    //WARNING MyFindText COUNTS FROM 0!!!! if found at start return value = 0 !!!
    function MyFindText(aStr: WideString; FromPosition: Integer = 1): Integer;
    function GetLineBreakStyle: TTntTextLineBreakStyle;
    function GetTextLenW: Integer;
    procedure MyDelete(aPos, aLength: Integer);

    procedure ReplaceText(const FromStr, ToStr: WideString);
    procedure ProcessIfStatement(const IfStatement: WideString; const aBoolean: Boolean); overload;
    procedure ProcessIfStatement(const IfStatement, ElseStatement, EndIfStatement: WideString; const aBoolean: Boolean); overload;

    property RawRTF: String read GetRawRTF write SetRawRTF;
  end;

  TTntRichEditAccessProtected = class(TTntRichEdit)
  public
    function LineBreakStyle: TTntTextLineBreakStyle; reintroduce;
  end;

function DefPrintRTFToCanvas(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  FromChar: Integer = 0; ToChar: Integer = -1): Longint;
function DefPrintRTFToCanvasTransparent(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  Rop: Cardinal; FromChar: Integer = 0; ToChar: Integer = -1): Longint;
function DefCalculateRTFHeight(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint;

function PrintRTFToCanvas(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint; overload;
function PrintRTFToCanvas(aRichRawText: String; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint; overload;
function CalculateRTFHeight(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint; overload;
function CalculateRTFHeight(aRichRawText: String; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint; overload;

procedure SetRawRTF(RE: TTntRichEdit; RawRTF: String);
function GetRawRTF(RE: TTntRichEdit): String;

function ReplaceRTFText(aRichRawText: String; aFromText, aToText: WideString): String;

function DrawRichEdit: TTntRichEdit;

implementation

uses RichEdit, Types, WideStrUtils, Math;

var
  XDrawRichEdit: TTntRichEdit = nil;

function DrawRichEdit: TTntRichEdit;
begin
  if Application.MainForm = nil then begin
    Result := nil;
    exit;
  end;

  if not Assigned(XDrawRichEdit) then begin
    XDrawRichEdit := TTntRichEdit.Create(Application.MainForm);
    XDrawRichEdit.Visible := False;
    XDrawRichEdit.Parent := Application.MainForm;
  end;
  Result := XDrawRichEdit;
end;

function GetRawRTF(RE: TTntRichEdit): String;
var
   strStream: TStringStream;
begin
   strStream := TStringStream.Create('') ;
   try
     RE.PlainText := False;
     RE.Lines.SaveToStream(strStream) ;
     Result := strStream.DataString;
   finally
     strStream.Free
   end;
end;

procedure SetRawRTF(RE: TTntRichEdit; RawRTF: String);
var
   strStream: TStringStream;
begin
   strStream := TStringStream.Create(RawRTF) ;
   try
     RE.PlainText := False;
     RE.Lines.LoadFromStream(strStream) ;
   finally
     strStream.Free
   end;
end;

function PrintRTFToCanvas(aRichRawText: String; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint;
var
  RE: TTntRichEdit;
begin
  RE := TTntRichEdit.Create(nil);
  with RE do
  try
    Visible := false;
    Parent := Application.MainForm;

    RE.RawRTF := aRichRawText;

    Result := PrintRTFToCanvas(RE, aCanvas, aRect, DPI, FromChar, ToChar);
  finally
    RE.Free;
  end;
end;

function DefCalculateRTFHeight(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer; FromChar: Integer; ToChar: Integer): Integer;
var
  MTF: TMetafile;
  MTFCanvas: TMetafileCanvas;
  Range: TFormatRange;
  rZoom: Single;
  SaveMapMode, LogX, LogY: Integer;
  SaveViewPort, SaveWindowExt: tagSize;
begin
  if Trim(aRichEdit.Text) = '' then begin
    Result := 0;
    exit;
  end;

  MTF := TMetafile.Create;
  MTFCanvas := TMetafileCanvas.Create(MTF, 0);
  try
    MTFCanvas.Font.Assign(aCanvas.Font);
    MTF.Width := aRect.Right-aRect.Left;
    MTF.Height := aRect.Bottom-aRect.Top;
    if DPI = 0 then
      DPI := ACanvas.Font.PixelsPerInch;
    LogX := GetDeviceCaps(MTFCanvas.Handle, LOGPIXELSX);
    LogY := GetDeviceCaps(MTFCanvas.Handle, LOGPIXELSY);

    rZoom := DPI/MTFCanvas.Font.PixelsPerInch;

    FillChar(Range, SizeOf(TFormatRange), 0);
    Range.hdc        := MTFCanvas.Handle;
    Range.hdcTarget  := MTFCanvas.Handle;
    Range.rc.left    := 0;
    Range.rc.top     := 0;
    Range.rc.right   := (aRect.Right-aRect.Left) * 1440 div DPI;
    Range.rc.Bottom  := (aRect.Bottom-aRect.Top) * 1440 div DPI;
    {Range.rc.left    := aRect.Left * 1440 div LogX;
    Range.rc.top     := aRect.Top * 1440 div LogY;
    Range.rc.right   := aRect.Right * 1440 div LogX;
    Range.rc.Bottom  := aRect.Bottom * 1440 div LogY;}
    if not((FromChar = 0) and (ToChar = 0)) then begin
      Range.chrg.cpMax := ToChar;
      Range.chrg.cpMin := FromChar;
    end else begin
      Range.chrg.cpMax := -1;
      Range.chrg.cpMin := 0;
    end;
    Range.rcPage := Range.rc;

    with MTFCanvas do begin
      SaveMapMode := GetMapMode(Handle);
      GetWindowExtEx(Handle, SaveWindowExt);
      GetViewportExtEx(Handle, SaveViewPort);
    end;
    try
      with MTFCanvas do begin
        SetMapMode(Handle, MM_TEXT);//MM_ANISOTROPIC MM_TEXT
        SetWindowExtEx(Handle, LogX, LogY, nil);
        SetViewportExtEx(Handle, Round(LogX * rZoom), Round(LogY * rZoom), nil);
      end;

      SendMessage(ARichedit.Handle, EM_FORMATRANGE, 0, Longint(@Range));
      SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);

      Result := Round(range.rc.bottom * DPI / 1440);
    finally
      with MTFCanvas do begin
        SetMapMode(Handle, SaveMapMode);
        SetWindowExtEx(Handle, SaveWindowExt.cx, SaveWindowExt.cy, nil);
        SetViewportExtEx(Handle, SaveViewPort.cx, SaveViewPort.cy, nil);
      end;
    end;
  finally
    MTFCanvas.Free;
    MTF.Free;
  end;
end;

function DefPrintRTFToCanvasTransparent(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  Rop: Cardinal; FromChar: Integer = 0; ToChar: Integer = -1): Longint;
var B: TBitmap;
begin
  B := TBitmap.Create;
  try
    B.Canvas.Font.Assign(aCanvas.Font);
    B.Width := aRect.Right-aRect.Left;
    B.Height := aRect.Bottom-aRect.Top;
    B.Canvas.Brush.Color := clWhite;
    B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));

    Result := DefPrintRTFToCanvas(aRichEdit, B.Canvas, Rect(0, 0, B.Width, B.Height), FromChar, ToChar);

    {B.TransparentColor := clWhite;  DOES NOT REALLY FUNCTION BECAUSE OF ANTIALIASING
    B.TransparentMode := tmFixed;
    B.Transparent := True;
    aCanvas.Draw(aRect.Left, aRect.Top, B);}
    BitBlt(aCanvas.Handle, aRect.Left, aRect.Top, B.Width, B.Height,
      B.Canvas.Handle, 0, 0, Rop);
  finally
    B.Free;
  end;
end;

function DefPrintRTFToCanvas(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  FromChar: Integer = 0; ToChar: Integer = -1): Longint; overload;
var
  Range: TFormatRange;
  SaveMapMode, LogX, LogY: Integer;
  //SaveViewPort, SaveWindowExt: tagSize;
  //B: TBitmap;
begin
  //B := TBitmap.Create;
  try
    //B.Canvas.Font.Assign(aCanvas.Font);
    //B.Width := aRect.Right-aRect.Left;
    //B.Height := aRect.Bottom-aRect.Top;
    //B.Canvas.Brush.Color := clWhite;
    //B.Canvas.FillRect(aRect);
    LogX := GetDeviceCaps(ACanvas.Handle, LOGPIXELSX);
    LogY := GetDeviceCaps(ACanvas.Handle, LOGPIXELSY);

    FillChar(Range, SizeOf(TFormatRange), 0);
    Range.hdc        := ACanvas.Handle;
    Range.hdcTarget  := ACanvas.Handle;
    {Range.rc.left    := 0;
    Range.rc.top     := 0;
    Range.rc.right   := B.Width * 1440 div DPI;
    Range.rc.Bottom  := B.Height * 1440 div DPI;}
    Range.rc.left    := aRect.Left * 1440 div LogX;
    Range.rc.top     := aRect.Top * 1440 div LogY;
    Range.rc.right   := aRect.Right * 1440 div LogX;
    Range.rc.Bottom  := aRect.Bottom * 1440 div LogY;
    if not((FromChar = 0) and (ToChar = 0)) then begin
      Range.chrg.cpMax := ToChar;
      Range.chrg.cpMin := FromChar;
    end else begin
      Range.chrg.cpMax := -1;
      Range.chrg.cpMin := 0;
    end;

    with ACanvas do begin
      SaveMapMode := GetMapMode(Handle);
      //GetWindowExtEx(Handle, SaveWindowExt);
      //GetViewportExtEx(Handle, SaveViewPort);
    end;
    try
      with ACanvas do begin
        SetMapMode(Handle, MM_TEXT);//MM_ANISOTROPIC
        //SetWindowExtEx(Handle, DPI, DPI, nil);
        //SetViewportExtEx(Handle, Round(DPI * rZoom), Round(DPI * rZoom), nil);
      end;
      {ARichedit.SelStart :=40;
      ARichedit.SelLength := 15;
      aRichEdit.SelAttributes.Color := clRed;}
      Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
      SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);

      //aCanvas.Draw(aRect.Left, aRect.Top, B);
      {BitBlt(aCanvas.Handle, aRect.Left, aRect.Top, B.Width, B.Height,
        B.Canvas.Handle, 0, 0, srcAND);}
    finally
      with ACanvas do begin
        SetMapMode(Handle, SaveMapMode);
        //SetWindowExtEx(Handle, SaveWindowExt.cx, SaveWindowExt.cy, nil);
        //SetViewportExtEx(Handle, SaveViewPort.cx, SaveViewPort.cy, nil);
      end;
    end;
  finally
    //B.Free;
  end;
end;

{function PrintRTFToCanvas(ARichEdit: TCustomRichEdit; ACanvas: TCanvas; aRect: TRect;
  DPI, FromChar, ToChar: Integer): Longint;
var
  LogX: Integer;
begin
  LogX := GetDeviceCaps(ACanvas.Handle, LOGPIXELSX);
  if DPI = 0 then
    DPI := ACanvas.Font.PixelsPerInch;
  if DPI <> LogX then
    result := DefPrintRTFToCanvasWithZoom(ARichEdit, ACanvas, aRect, DPI, FromChar, ToChar)
  else
    result := DefPrintRTFToCanvas(aRichEdit, aCanvas, aRect, FromChar, ToChar);
end;}

function CalculateRTFHeight(aRichRawText: String; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint;
begin
  DrawRichEdit.RawRTF := aRichRawText;
  Result := CalculateRTFHeight(DrawRichEdit, aCanvas, aRect, DPI, FromChar, ToChar);
end;

function CalculateRTFHeight(aRichEdit: TCustomRichEdit; aCanvas: TCanvas; aRect: TRect;
  DPI: Integer = 0; FromChar: Integer = 0; ToChar: Integer = -1): Longint;
{var
  LogX: Integer;
  MTF: TMetafile;
  MTFCanvas: TMetafileCanvas;
  aZoom: Single;}
begin
  Result := DefCalculateRTFHeight(aRichEdit, aCanvas, Rect(0, 0, Round((aRect.Right-aRect.Left)), High(SmallInt)), DPI);

  {LogX := GetDeviceCaps(aCanvas.Handle, LOGPIXELSX);
  if DPI = 0 then
    DPI := LogX;

  MTF := TMetafile.Create;
  try
    MTFCanvas := TMetafileCanvas.Create(MTF, 0);
    with MTFCanvas do
    try
      LogX := GetDeviceCaps(Handle, LOGPIXELSX);

      aZoom := DPI / LogX;
      if aZoom <= 0 then
        aZoom := 1;

      Result := Round(DefCalculateRTFHeight(aRichEdit, MTFCanvas, Rect(0, 0, Round((aRect.Right-aRect.Left) / aZoom), High(SmallInt)), 0) * aZoom);
      //Result := Round(DefCalculateRTFHeight(aRichEdit, MTFCanvas, aRect, 0) * aZoom);
    finally
      Free;
    end;
  finally
    MTF.Free;
  end;}
end;

function PrintRTFToCanvas(ARichEdit: TCustomRichEdit; ACanvas: TCanvas; aRect: TRect;
  DPI, FromChar, ToChar: Integer): Longint;
var
  LogX: Integer;
  MTF: TMetafile;
  MTFCanvas: TMetafileCanvas;
  aZoom: Single;
begin
  LogX := GetDeviceCaps(aCanvas.Handle, LOGPIXELSX);
  if DPI = 0 then
    DPI := LogX;

  if DPI = LogX then begin
    result := DefPrintRTFToCanvas(aRichEdit, aCanvas, aRect, FromChar, ToChar);{}
  end else begin
    MTF := TMetafile.Create;
    try
      with TMetafileCanvas.Create(MTF, 0) do
      try
        LogX := GetDeviceCaps(Handle, LOGPIXELSX);
      finally
        Free;
      end;

      aZoom := DPI / LogX;
      if aZoom <= 0 then
        aZoom := 1;

      MTF.Width := Round((aRect.Right-aRect.Left) / aZoom);
      //ShowMessage(IntToStr((aRect.Right-aRect.Left))+':'+IntToStr(MTF.Width));
      MTF.Height := Round((aRect.Bottom-aRect.Top) / aZoom);

      MTFCanvas := TMetafileCanvas.Create(MTF, 0);
      with MTFCanvas do
      try
        Result := DefPrintRTFToCanvas(aRichEdit, MTFCanvas, Rect(0, 0, MTF.Width, MTF.Height), FromChar, ToChar);
      finally
        MTFCanvas.Free;
      end;

      //MTF.Width := Round((aRect.Right-aRect.Left) / 1);
      //ShowMessage(IntToStr((aRect.Right-aRect.Left))+':'+IntToStr(MTF.Width));
      //MTF.Height := Round((aRect.Bottom-aRect.Top) / 1);

      ACanvas.StretchDraw(aRect, MTF);
      //ACanvas.Draw(0, 0, MTF);
    finally
      MTF.Free;
    end;{}
  end;
  
  {LogX := GetDeviceCaps(ACanvas.Handle, LOGPIXELSX);
  if DPI = 0 then
    DPI := ACanvas.Font.PixelsPerInch;
  if DPI <> LogX then
    result := DefPrintRTFToCanvasWithZoom(ARichEdit, ACanvas, aRect, DPI, FromChar, ToChar)
  else
    result := DefPrintRTFToCanvas(aRichEdit, aCanvas, aRect, FromChar, ToChar);{}
end;


{ TPrintRichEdit }

function TPrintRichEdit.DrawTo(ACanvas: TCanvas; aRect: TRect; DPI, FromChar,
  ToChar: Integer): Longint;
begin
  Result := PrintRTFToCanvas(Self, ACanvas, aRect, DPI, FromChar, ToChar);
end;

function TPrintRichEdit.GetRawRTF: String;
begin
  Result := PrintRichText.GetRawRTF(Self);

  Result := TrimRight(WideReplaceText(Result, #0, '')); 
end;

function TPrintRichEdit.GetTextLenW: Integer;
begin
  //Result := TntAdjustLineBreaksLength(Text, GetLineBreakStyle);
  Result := TntAdjustLineBreaksLength(TntControl_GetText(Self), GetLineBreakStyle);
end;

function TPrintRichEdit.GetLineBreakStyle: TTntTextLineBreakStyle;
begin
  Result := TTntRichEditAccessProtected(Self).LineBreakStyle;
end;

procedure TPrintRichEdit.MyDelete(aPos, aLength: Integer);
begin
  SelStart := aPos-1;
  SelLength := aLength;
  SelText := '';
end;

function TPrintRichEdit.MyFindText(aStr: WideString;
  FromPosition: Integer): Integer;
begin
  Result := FindText(aStr, FromPosition-1, Length(Text)-FromPosition+1, [])+1;
end;

procedure TPrintRichEdit.ProcessIfStatement(const IfStatement, ElseStatement,
  EndIfStatement: WideString; const aBoolean: Boolean);
var pos1, pos2, pos3: Integer;
  I: Integer;
begin
  I := 0;
  pos1 := MyFindText(IfStatement);
  while (pos1 <> 0) and (I < 20) do begin
    MyDelete(pos1, Length(IfStatement));

    pos2 := MyFindText(ElseStatement, pos1);
    pos3 := MyFindText(EndIfStatement, pos1);
    pos2 := Min(pos2, pos3);
    if (pos2 = 0) then
      pos2 := pos3;
    if aBoolean then begin
      MyDelete(pos2, pos3-pos2+Length(EndIfStatement));
    end else begin
      MyDelete(pos1, pos2-pos1);
      if (MyFindText(ElseStatement, pos1) = pos1) then
        MyDelete(pos1, Length(ElseStatement));
      pos1 := MyFindText(EndIfStatement, pos1);
      MyDelete(pos1, Length(EndIfStatement));
    end;
    pos1 := MyFindText(IfStatement);
    Inc(I);
  end;
end;

procedure TPrintRichEdit.ProcessIfStatement(const IfStatement: WideString;
  const aBoolean: Boolean);
var ElseStatement, EndIfStatement: WideString;
begin
  if Length(IfStatement) > 0 then begin
    ElseStatement := IfStatement[1] + 'ELSE' + IfStatement[Length(IfStatement)];
    EndIfStatement := IfStatement[1] + 'ENDIF' + IfStatement[Length(IfStatement)];

    ProcessIfStatement(IfStatement, ElseStatement, EndIfStatement, aBoolean);
  end;
end;

procedure TPrintRichEdit.ReplaceText(const FromStr, ToStr: WideString);
var X: Integer;
begin
  X := 1;
  X := MyFindText(FromStr, X);
  while X <> 0 do begin
    SelStart := X-1;
    SelLength := Length(FromStr);
    SelText := ToStr;
    X := MyFindText(FromStr, X + Length(ToStr));
  end;
end;

procedure TPrintRichEdit.SetRawRTF(const Value: String);
begin
  PrintRichText.SetRawRTF(Self, Value);
end;

function ReplaceRTFText(aRichRawText: String; aFromText, aToText: WideString): String;
var
  RE: TTntRichEdit;
begin
  RE := TTntRichEdit.Create(nil);
  with RE do
  try
    Visible := false;
    Parent := Application.MainForm;

    RawRTF := aRichRawText;

    ReplaceText(aFromText, aToText);

    Result := RawRTF;
  finally
    RE.Free;
  end;
end;



{ TTntRichEditAccessProtected }

function TTntRichEditAccessProtected.LineBreakStyle: TTntTextLineBreakStyle;
begin
  Result := inherited LineBreakStyle;
end;

end.

how to use that:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, TntComCtrls;

type
  TForm1 = class(TForm)
    RE1: TTntRichEdit;
    BtnSynopseRTFTest: TButton;
    BtnMorePagesTest: TButton;
    procedure BtnSynopseRTFTestClick(Sender: TObject);
    procedure BtnMorePagesTestClick(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure DoCreate; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses SynPDF, PrintRichText, TntSysUtils;

procedure TForm1.BtnMorePagesTestClick(Sender: TObject);
var
  xPDF: TPdfDocumentGDI;
  xRect: TRect;
  xMF: TMetafile;
  xMFC: TMetaFileCanvas;
  xHeight, xLastChar, xMaxChar, I: Integer;

begin
  xPDF := TPdfDocumentGDI.Create;
  xMF := TMetafile.Create;
  try
    xPDF.AddPage;

    xLastChar := -1;
    //xMaxChar := RE1.GetTextLen;//USE FOR NORMAL RichEdit
    xMaxChar := RE1.GetTextLenW;
    I := 0;
    repeat
      xRect := Rect(100, 100+I*200, 300, 190++I*200);
      xLastChar := PrintRTFToCanvas(RE1, xPDF.VCLCanvas, xRect, 0, xLastChar);
      with xPDF.VCLCanvas do begin
        Brush.Style := bsClear;
        Pen.Width := 1;
        Pen.Color := clBlack;
        Rectangle(xRect);
      end;
      Inc(I);
    until (xLastChar >= xMaxChar) or (xLastChar = -1);
    
    xPDF.SaveToFile('a.pdf');
  finally
    xPDF.Free;
    xMF.Free;
  end;
end;

procedure TForm1.BtnSynopseRTFTestClick(Sender: TObject);
var
  xPDF: TPdfDocumentGDI;
  xRect: TRect;
  xMF: TMetafile;
  xMFC: TMetaFileCanvas;
  xHeight, xLastChar: Integer;

begin
  xPDF := TPdfDocumentGDI.Create;
  xMF := TMetafile.Create;
  try
    xPDF.AddPage;

    xRect := Rect(100, 100, 300, 1000);
    xHeight := CalculateRTFHeight(RE1, xPDF.VCLCanvas, xRect);
    xRect.Bottom := xRect.Top + xHeight;
    PrintRTFToCanvas(RE1, xPDF.VCLCanvas, xRect);
    with xPDF.VCLCanvas do begin
      Brush.Style := bsClear;
      Pen.Width := 1;
      Pen.Color := clBlack;
      Rectangle(xRect);
    end;

    xPDF.SaveToFile('a.pdf');
  finally
    xPDF.Free;
    xMF.Free;
  end;
end;

procedure TForm1.DoCreate;
var xStr: TStrings;
  I: Integer;
begin
  inherited;

  xStr := TStringList.Create;
  try
    if FileExists('a.rtf') then
      xStr.LoadFromFile('a.rtf');
    RE1.RawRTF := xStr.Text;
  finally
    xStr.Free;
  end;
end;

end.

EDIT: one example more

Last edited by reddwarf (2010-08-03 21:06:58)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,206

Website

Re: Print Preview and PDF generation from any TRichEdit component content

Thanks to your code, I found out what was wrong with the height calculation. Just one line to be added.
It's now fixed, and work as expected.

Here is how the whole conversion is done.  I put this method in our reporting component (located in SQLite3Pages unit), because it sounded more convenient to have an optional preview, plus margins+header+footer+page numbering, together with some easy text or title adding.

procedure TGDIPages.AppendRichEdit(RichEditHandle: HWnd);
var Range: TFormatRange;
    LogX, LogY, LastChar, MaxLen, OldMap: integer;
begin
  with Range do begin
    LogX := GetDeviceCaps(fCanvas.Handle, LOGPIXELSX);
    LogY := GetDeviceCaps(fCanvas.Handle, LOGPIXELSY);
    rcPage.Left := (fPageMarginsPx.Left*1440) div LogX;
    rcPage.Right := ((fPhysicalSizePx.x-fPageMarginsPx.Right)*1440) div LogX;
    rcPage.Top := ((fPageMarginsPx.Top+fHeaderHeight)*1440) div LogY;
    rcPage.Bottom := ((fPhysicalSizePx.y-fPageMarginsPx.Bottom-fFooterHeight)*1440) div LogY;
    rc := rcPage;
    rc.Top := (fCurrentYPos*1440) div LogY;
    LastChar := 0;
    MaxLen := SendMessage(RichEditHandle,WM_GETTEXTLENGTH,0,0);
    chrg.cpMax := -1;
    OldMap := SetMapMode(hdc, MM_TEXT);
    try
      SendMessage(RichEditHandle, EM_FORMATRANGE, 0, 0);
      repeat
        chrg.cpMin := LastChar;
        hdc := fCanvas.Handle;
        hdcTarget := hdc;
        LastChar := SendMessage(RichEditHandle, EM_FORMATRANGE, 1, Integer(@Range));
        if cardinal(LastChar)>=cardinal(MaxLen) then 
          break;
        NewPageInternal;
        DoHeader;
        rc := rcPage;
      until false;
      fCurrentYPos := (rc.Bottom*LogY) div 1440;
    finally
      SendMessage(RichEditHandle, EM_FORMATRANGE, 0, 0);
      SetMapMode(hdc, OldMap);
    end;
  end;
end;

My implementation sounds much more easier to read than yours. So I'll stay with this code!

Source code repository has been updated, together with the source code of this tool, available from
http://synopse.info/files/pdf/pdfrichedit.zip.

Thanks again reddwarf for you clever feedback and source sharing!

Hope it'll be useful!

reddwarf

Member

Registered: 2010-06-28

Posts: 40

Website

Re: Print Preview and PDF generation from any TRichEdit component content

yes, you are right. your code is easier, but does the thing a little bit differently. therefore someone may find it useful and now i remember where i took inspiration - in the original delphi source code

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,206

Website

Re: Print Preview and PDF generation from any TRichEdit component content

My inspiration was the delphi source code, but even more some source code in C from MSDN web site, which was even clearer.

vannus

Member

Registered: 2011-03-30

Posts: 1

Re: Print Preview and PDF generation from any TRichEdit component content

Just thought I'd mention - tabs seem to change between richedit & pdf. Is there possibly some difference between RichEdit tab spacing and SynPdf tab spacing? or maybe the font changes??

rich text file with tabs - https://docs.google.com/leaf?id=0B4P52L … y=CPfD-osO

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,206

Website

Re: Print Preview and PDF generation from any TRichEdit component content

Tabs are always relative to the font it works on. If the resulting text width is shorter than a tab position, it will go to the previous tab. Or to the next tab if the text width exceeds the expected tab position.

The RichEdit content is printed into the pdf canvas just by using the windows API calls.
Perhaps there is some "hole" in our GDI -> pdf conversion routine, but it has been proven and checked since last months.

I would never rely on rich text format for precise tab layout.

Gemsys

Member

Registered: 2011-06-12

Posts: 6

Re: Print Preview and PDF generation from any TRichEdit component content

My configuration is Delphi 5, the WPControls, and the IP (Wol2Wol) controls.

I have a requirement to print RTF to a PDF file, and having sucessfully implemented the SynPDF Unit, was hoping to use PrintRichText unit for this purpose.  However, having downloaded the files in this thread have found them to contain Tnt components and a Variants Unit that I do not have.  Are these readily available anywhere?

Even if I download them, I am using WP components for letter writing.  Would I be able to convert the PrintRichTextEdit Unit to use them?  ie does PrintRichTextEdit use properties that are not part of the fundamental TRichEdit component?

Thanks in advance for any assistance,
Geoff

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,206

Website

Re: Print Preview and PDF generation from any TRichEdit component content

Code just above in this page is not the official code of our libraries.
It is just one way of using it, from one customer nice enough to share its own sample code.

See the TOP of this message - http://synopse.info/forum/viewtopic.php?id=76 - for the original code.

RichEdit export is handled in SynPdf + SQLite3Pages.
I did not test it under Delphi 5, but it may work (it does not use Variants and has conditionals to handle it). It is tested from Delphi 6 up to XE2.