將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; 

範圍參數傳遞的，這樣我就可以用這個方法以外的計算尺寸。 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 

左邊項是像素，並且正確的術語是在像素/英寸，所以結果的單位是pixels²/英寸。 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;