Painting TRichEdit on canvas

Question

I am trying to embed an RTF compatible tooltip window in Delphi XE. To make rich text, I use the TRichEdit splash screen. I need to do two things:

• Measure the size of the text.
• Draw text

To accomplish both tasks, I wrote this method:

procedure TLookupHintWindow.CallFormatRange(R: TRect; var Range: TFormatRange; MustPaint: Boolean); var TextRect: TRect; begin RichText.SetBounds(R.Left, R.Top, R.Right, R.Bottom); TextRect := Rect(0, 0, RichText.Width * Screen.Pixelsperinch, RichText.Height * Screen.Pixelsperinch); ZeroMemory(@Range, SizeOf(Range)); Range.hdc := Canvas.Handle; Range.hdcTarget := Canvas.Handle; Range.rc := TextRect; Range.rcpage := TextRect; Range.chrg.cpMin := 0; Range.chrg.cpMax := -1; SendMessage(RichText.Handle, EM_FORMATRANGE, NativeInt(MustPaint), NativeInt(@Range)); SendMessage(RichText.Handle, EM_FORMATRANGE, 0, 0); end; 

The Range parameter is passed, so I can use the calculated measurements outside this method. The MustPaint parameter determines whether the range should be calculated (False) or colored (True).

To calculate the range, I call this method:

 function TLookupHintWindow.CalcRichTextRect(R: TRect; const Rtf: string): TRect; var Range: TFormatRange; begin LoadRichText(Rtf); CallFormatRange(R, Range, False); Result := Range.rcpage; Result.Right := Result.Right div Screen.PixelsPerInch; Result.Bottom := Result.Bottom div Screen.PixelsPerInch; // In my example yields this rect: (0, 0, 438, 212) end; 

To draw it:

 procedure TLookupHintWindow.DrawRichText(const Text: string; R: TRect); var Range: TFormatRange; begin CallFormatRange(R, Range, True); end; 

The problem is that although it calculates a rectangle with a width of 438 pixels and a height of 212, it actually paints a very wide (cropped) one and has only 52 pixels.

I have word wrap enabled, although it seemed to me that this was not necessary.

Any ideas?

Answer 1

Your devices are disconnected. Consider this expression from your code, for example:

 RichText.Width * Screen.Pixelsperinch 

The left term is in pixels and the right term is in pixels / inches, so the units of the result are ² / inch pixels. The expected unit for the rectangles used in em_FormatRange is twips. If you want to convert pixels to twips, you will need the following:

 const TwipsPerInch = 1440; RichText.Width / Screen.PixelsPerInch * TwipsPerInch 

---

You do not need an off-screen advanced editing control. You just need a contactless editor with advanced editing , which you can instruct to draw directly on the tooltip. I posted some Delphi code that simplifies the basics. Beware that it does not support Unicode, and I have no plans to do so (although it may not be too difficult to do).

The main function from my DrawRTF code, shown below, is in RTFPaint.pas. However, this does not quite meet your needs; you want to know the size before drawing it, while my code assumes that you already know the size of the drawing target. To measure RTF text size, call ITextServices.TxGetNaturalSize .

Word wrap is important. Without it, the control will assume that it has infinite width to work, and it will only start a new line when the RTF text requests it.

 procedure DrawRTF(Canvas: TCanvas; const RTF: string; const Rect: TRect; const Transparent, WordWrap: Boolean); var Host: ITextHost; Unknown: IUnknown; Services: ITextServices; HostImpl: TTextHostImpl; Stream: TEditStream; Cookie: TCookie; res: Integer; begin HostImpl := TDrawRTFTextHost.Create(Rect, Transparent, WordWrap); Host := CreateTextHost(HostImpl); OleCheck(CreateTextServices(nil, Host, Unknown)); Services := Unknown as ITextServices; Unknown := nil; PatchTextServices(Services); Cookie.dwCount := 0; Cookie.dwSize := Length(RTF); Cookie.Text := PChar(RTF); Stream.dwCookie := Integer(@Cookie); Stream.dwError := 0; Stream.pfnCallback := EditStreamInCallback; OleCheck(Services.TxSendMessage(em_StreamIn, sf_RTF or sff_PlainRTF, lParam(@Stream), res)); OleCheck(Services.TxDraw(dvAspect_Content, 0, nil, nil, Canvas.Handle, 0, Rect, PRect(nil)^, PRect(nil)^, nil, 0, txtView_Inactive)); Services := nil; Host := nil; end;