RichEdit: Breite und Höhe des Inhalts bestimmen

[Flocke]

Hatte ich hier mal gepostet aber nie mehr daran gedacht es auch für die CL vorzuschlagen.

Die Funktion berechnet die Höhe des in einem RichEdit-Control dargestellten Textes bei einer vorgegebenen Breite (Vorgabe: Darstellungsbreite), wahlweise des gesamten Textes oder der aktuellen Auswahl. Zusätzlich kann man sich auch noch die minimale Breite bei dieser Höhe berechnet lassen.

Hier die aktuelle Version:

Delphi-Quellcode:

uses
  RichEdit;

function GetRichEditTextExtent(hRichEdit: HWND; nWidth: integer;
  fExactWidth: boolean = false; fSelection: boolean = false): TPoint;
var
  dc: HDC;
  fr: TFormatRange;
  res: TPoint;
  wmin, wmid, wmax: integer;

  // Berechnet die Umbruchbreite des RichEdit-Controls
  function ClientWidth: integer;
  var
    rc: TRect;
  begin
    GetClientRect(hRichEdit, rc);
    SendMessage(hRichEdit, EM_GETRECT, 0, LPARAM(@rc));
    Result := rc.Right - rc.Left;
  end;

  // Berechnet für die Breite "w" die formatierte Höhe
  function CalcHeight(w: integer): integer;
  begin
    fr.rc := Rect(0, 0, MulDiv(w, 1440, res.x), $1000000);
    fr.rcPage := fr.rc;
    SendMessage(hRichEdit, EM_FORMATRANGE, 0, LPARAM(@fr));
    Result := MulDiv(fr.rc.Bottom, res.y, 1440);
  end;

begin
  dc := GetDC(0);
  try
    // Bildschirmauflösung für Twips <-> Pixel
    res.x := GetDeviceCaps(dc, LOGPIXELSX);
    res.y := GetDeviceCaps(dc, LOGPIXELSY);

    // Die FORMATRANGE-Struktur initialisieren
    fr.hdc := dc;
    fr.hdcTarget := dc;

    if fSelection then
      SendMessage(hRichEdit, EM_EXGETSEL, 0, LPARAM(@fr.chrg))
    else
    begin
      fr.chrg.cpMin := 0;
      fr.chrg.cpMax := -1;
    end;

    // Maximale Formatierungsbreite
    if nWidth <= 0 then
      Result.X := ClientWidth
    else
      Result.X := nWidth;

    // Für die maximale Breite die Höhe bestimmen
    Result.Y := CalcHeight(Result.X);

    if fExactWidth then
    begin
      // Dies ist nicht exakt. Wir berechnen hier nur die minimale
      // Breite, bei der der formatierte Text nicht höher als die
      // oben berechnet Basishöhe ist.
      wmin := 1;
      wmax := Result.X;

      // Binäre Suche
      while wmin <= wmax do
      begin
        wmid := (wmin + wmax) div 2;
        if CalcHeight(wmid) <= Result.Y then
        begin
          Result.X := wmid;
          wmax := wmid - 1;
        end
        else
          wmin := wmid + 1;
      end;
    end;
  finally
    // Ressourcen wieder freigeben
    SendMessage(hRichEdit, EM_FORMATRANGE, 0, 0);
    ReleaseDC(0, dc);
  end;
end;