Yes, you can use the EM_FORMATRECT message to get the richedit to paint
its contents onto any canvas. Only take care to use TrueType fonts for
the control, with other fonts the scaling of the outout canvas will
sometimes not work properly. Here is an example:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
Image1: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses printers, richedit;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
zoomfactor, xScale, yScale: Single;
pagerect, outputrect : TRect;
fmtRange: TFormatRange;
begin
zoomfactor := 0.5;
xScale := Screen.PixelsPerInch / GetDeviceCaps( Printer.handle, LOGPIXELSX );
yScale := Screen.PixelsPerInch / GetDeviceCaps( Printer.handle, LOGPIXELSY );
// Size bitmap to 50% of size of a printer page and fill it white
With image1.Picture.Bitmap Do
Begin
Width := Round( Printer.Pagewidth * zoomfactor * xScale );
Height:= Round( Printer.PageHeight * zoomfactor * yScale );
With Canvas Do
Begin
Brush.Color := clWhite;
Brush.Style := bsSolid;
FillRect( Cliprect );
End;
End;
// scale the bitmap canvas according to the zoomfactor
With image1.Picture.Bitmap.Canvas Do
Begin
SetMapMode( handle, MM_ANISOTROPIC );
SetWindowExtEx(handle,
Screen.PixelsPerInch, Screen.PixelsPerInch,
Nil);
SetViewportExtEx(handle,
Round(Screen.PixelsPerInch * zoomfactor),
Round(Screen.PixelsPerInch * zoomfactor),
Nil);
End;
// set up a page rectangle for the rich edit control and
// an output area inside, which gives us some margins. The
// units here are twips (1/1440 inch).
With image1.Picture.Bitmap Do
pagerect := Rect( 0, 0,
Round(width * 1440 / Screen.PixelsPerInch / xScale),
Round(height * 1440 / Screen.PixelsPerInch / yScale) );
outputrect := pagerect;
InflateRect( outputrect, -720, -720 ); // 1/2 inch margin
// set up the parameter record for EM_FORMATRANGE
fillChar( fmtRange, sizeof(fmtrange), 0);
With fmtRange Do
Begin
hDC := image1.Picture.Bitmap.Canvas.Handle;
hdcTarget := hDC;
rc := outputrect;
rcPage := pagerect;
chrg.cpMin := 0;
chrg.cpMax := richedit1.GetTextLen-1;
End;
// format the text
richedit1.Perform( EM_FORMATRANGE, 1, Longint(@fmtRange));
// Free cached information
richedit1.Perform( EM_FORMATRANGE, 0, 0);
end;
end. |
|
