5

Delphi XE で RTF 対応のツール ヒント ウィンドウを実装しようとしています。リッチ テキストをレンダリングするために、オフスクリーン TRichEdit を使用しています。私は2つのことをする必要があります:

  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 ピクセルしかない四角形を描画することです。

ワードラップをオンにしていますが、それは必要ないというのが私の印象でした。

何か案は？

4

1 に答える 1

6

あなたのユニットはオフです。たとえば、コードから次の式を考えてみましょう。

RichText.Width * Screen.Pixelsperinch

左の項はピクセル単位で、右の項はピクセル/インチ単位であるため、結果の単位はピクセル²/インチです。で使用される長方形の想定単位em_FormatRangeは twip です。ピクセルを twip に変換する場合は、次のものが必要です。

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;
于 2011-10-13T15:20:02.110 に答える