Take the 2-minute tour ×

I'm trying to implement an RTF-capable tool tip window in Delphi XE. To render the rich text, I'm using an off-screen TRichEdit. I need to do two things:

  1. Measure the size of the text.
  2. Paint the text

To accomplish both tasks, I wrote this method:

procedure TLookupHintWindow.CallFormatRange(R: TRect; var Range: TFormatRange;
  MustPaint: Boolean);
  TextRect: TRect;
  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);

The Range parameter is passed in, so I can use the calculated dimensions outside this method. The MustPaint parameter determines if the range should be calculated (False) or painted (True).

To calculate the range, I call this method:

function TLookupHintWindow.CalcRichTextRect(R: TRect; const Rtf: string): TRect;
  Range: TFormatRange;

  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)

To paint it:

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

The problem is that while it calculates a rectangle that is 438 pixels wide and 212 high, it actually paints one that is very wide (gets clipped) and only 52 pixels high.

I have word wrap turned on, although it was my impression that that should not be needed.

Any ideas?

share|improve this question
You don't you just include a read-only TRichTextEdit on your tooltop control. sounds much easier than what you're doing. –  Johan Oct 13 '11 at 10:57
That is the plan if I don't get this strategy to work. The reason is that tool tips in general have a gradient background which will be hidden by the control. Which will make the RTF tool tips stand out from others on the same screen. Thing is, I'm using the same call to do the calculation, so I would expect the painting to work just fine. –  Cobus Kruger Oct 13 '11 at 13:54
Can't you make the richedit transparent, and put a slightly darker gradient in the background? See here fro some transparency code: stackoverflow.com/questions/7750224/… –  Johan Oct 13 '11 at 14:04
add comment

1 Answer

up vote 5 down vote accepted

Your units are off. 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/inch, so the units of the result are pixels²/inch. The expected unit for the rectangles used in em_FormatRange is twips. If you want to convert pixels to twips, you need this:

  TwipsPerInch = 1440;

RichText.Width / Screen.PixelsPerInch * TwipsPerInch

You don't need an off-screen rich-edit control. You just need a windowless rich-edit control, which you can instruct to paint directly onto your tool-tip. I've published some Delphi code that makes the basics straightforward. Beware that it's not Unicode-aware, and I have no plans to make it so (although it might not be too complicated to do).

The main function from my code is DrawRTF, shown below, in RTFPaint.pas. It doesn't quite fit your needs, though; you want to discover the size before drawing it, whereas my code assume you already know the dimensions of the drawing target. To measure the size of the RTF text, call ITextServices.TxGetNaturalSize.

Word wrapping is important. Without it, the control will assume it has infinite width to work with, 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);
  Host: ITextHost;
  Unknown: IUnknown;
  Services: ITextServices;
  HostImpl: TTextHostImpl;
  Stream: TEditStream;
  Cookie: TCookie;
  res: Integer;
  HostImpl := TDrawRTFTextHost.Create(Rect, Transparent, WordWrap);
  Host := CreateTextHost(HostImpl);
  OleCheck(CreateTextServices(nil, Host, Unknown));
  Services := Unknown as ITextServices;
  Unknown := nil;

  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;
share|improve this answer
Wow, looks great! I'll spend some time on this today and see if it is all I need. My comment about word wrap: I know what it does and why it's important, but it is also on by default when you add a TRichEdit control to a form, so turning it on when the control is created at runtime should not be needed. –  Cobus Kruger Oct 14 '11 at 7:54
add comment

Your Answer


