Rendern von TRichEdit auf TBitmap

[Dani]

Diese Monströsität stellt das RichEdit zwar richtig dar, aber es ist nicht gerade elegant... egal.

Delphi-Quellcode:

function TMyRichEdit.RenderText(TargetCanvas: TCanvas; TestMetricsOnly: Boolean): Integer;
//Code based on a sample by P. Below  [url]www.swissdelphicenter.com[/url]
var
  fmt: TFormatRange;
  Flag: Integer;
  OldBkMode: Integer;
  LogX, LogY: Integer;
  FactorX, FactorY: Double;
  BackupRTF: TMemoryStream;
  i: Integer;
begin
 LogX := GetDeviceCaps(TargetCanvas.Handle, LOGPIXELSX);
 LogY := GetDeviceCaps(TargetCanvas.Handle, LOGPIXELSY);
 FactorX := PPIx / LogX;
 FactorY := PPIy / LogY;

 BackupRTF := TMemoryStream.Create;
 try
  BackupRTF.Position := 0;
  Self.Lines.SaveToStream(BackupRTF);
  Self.Lines.BeginUpdate;
  try
   for i:=0 to Self.GetTextLen-1 do
    begin
     SelStart := i;
     SelLength := 1;
     SelAttributes.Height := round(SelAttributes.Height * FactorY);
    end;

   If TestMetricsOnly then Flag := 0 else Flag := 1;
   with fmt do
   begin
    hdc:= TargetCanvas.Handle;
    hdcTarget:= hdc;
    // rect needs to be specified in twips (1/1440 inch) as unit
    rc:=  Rect( FPxLeft * 1440 div LogX,
                FPxTop  * 1440 div LogY,
                (FPxLeft + FPxWidth) * 1440 div LogX,
                (FPxTop + FPxHeight) * 1440 div LogY);
    rcPage:= rc;
    chrg.cpMin := 0;
    chrg.cpMax := Self.GetTextLen;
   end;
   OldBkMode := SetBkMode(TargetCanvas.Handle, TRANSPARENT);
   Result := SendMessage(Self.Handle, EM_FORMATRANGE, Flag, lParam(@fmt));
   // next call frees some cached data
   SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);
   SetBkMode(TargetCanvas.Handle, OldBkMode);
  finally
   BackupRTF.Position := 0;
   Self.Lines.LoadFromStream(BackupRTF);
   Self.Lines.EndUpdate;
  end;
 finally
  BackupRTF.Free;
 end;
end;