Question

我正在尝试在Delphi XE中实现支持RTF的工具提示窗口。为了渲染富文本，我正在使用屏幕外的TRichEdit。我需要做两件事：

测量文字的大小。
绘制文字

为了完成这两项任务，我写了这个方法：

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;

传入Range参数，因此我可以使用此方法之外的计算尺寸。 MustPaint参数确定是应该计算范围（False）还是绘制（True）。

要计算范围，我称之为：

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;

画它：

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

问题在于，虽然它计算出一个宽438像素，高212像素的矩形，但它实际上会绘制一个非常宽（被剪裁）并且只有52像素高的矩形。

我打开了自动换行，虽然我的印象是不应该这样做。

有什么想法吗？

Answer 1

你的单位已关闭。从代码中考虑这个表达式，例如：

RichText.Width * Screen.Pixelsperinch

左边的术语以像素为单位，右边的术语以像素/英寸为单位，因此结果的单位是像素²/英寸。 em_FormatRange中使用的矩形的预期单位是缇。如果您想将像素转换为缇，则需要：

const
  TwipsPerInch = 1440;

RichText.Width / Screen.PixelsPerInch * TwipsPerInch

您不需要屏幕外的富编辑控件。您只需要windowless rich-edit control，您可以指示直接在工具提示上绘制。 I've published some Delphi code that makes the basics straightforward.请注意，它不是支持Unicode的，我没有计划这样做（虽然它可能不会太复杂）。

我的代码中的主要功能是DrawRTF，如下所示，位于 RTFPaint.pas 中。但是，它不太适合您的需求;你想在绘制之前发现大小，而我的代码假设你已经知道绘图目标的尺寸。要衡量RTF文本的大小，请致电ITextServices.TxGetNaturalSize。

自动换行很重要。如果没有它，控件将假定它具有无限宽度，并且只有在RTF文本请求时才会启动新行。

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;

将TRichEdit绘制到画布上

1 个答案: