将TRichEdit绘制到画布上

Question

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

1. 测量文本的大小.
2. 绘制文本

为了完成这两个任务,我写了这个方法:

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

您不需要屏幕外的富编辑控件.您只需要一个无窗口的富编辑控件,您可以指示直接在工具提示上绘制.我发布了一些Delphi代码,使基础知识变得简单明了.请注意,它不是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;