lzRichEdit auf Canvas zeichnen

[AlterMann]

Hallo

Ich versuch schon den ganzen Tag den formatierten Text eines lzRichEdit auf die Canvas eines Image (Druckvorschau) zu bringen.

Ich habe dieses Beispiel (allerdings für ein RichEdit in Delphi) gefunden und angepaßt:

Code: Alles auswählen

 uses RichEdit;
// Sonic Delphi
 // soulyx@yahoo.com
 
 
function RTFtoBitmap(myRTF: TRichEdit; GiveSpaceForBorder: Integer): TBitmap;
 
   // using myRTF parameter with your TRichEdit control name,
   // default name "RichEdit1".
   // For GiveSpaceForBorder parameter, sometimes you need to draw
   // the RichEdit control with rectangle colorfull border, so you need
   // to give space for it.
var
   myRect: TRect;
   temp: TBitmap;
begin
   temp := TBitmap.Create;
 
   myRect := myRTF.ClientRect;
   // if you are using PRF_NONCLIENT parameter in myRTF.perform command
   // using this statement
   // myRect := Rect(0,0,MyRTF.Width,MyRTF.Height);
 
   temp.Width  := myRect.Right;
   temp.Height := myRect.Bottom;
   with temp.Canvas do
   begin
     Lock;
     try
       myRTF.Perform(WM_PRINT, Handle, PRF_CLIENT);
       //you can trying to change PRF_CLIENT with
       //PRF_CHILDREN or PRF_CLIENT or PRF_NONCLIENT or PRF_ERASEBKGND
       //or combine them. See what happen...
     finally
       Unlock
     end;
   end;
   Result := TBitmap.Create;
   Result := CreateEmptyBmp(clWhite,
     temp.Width + GiveSpaceForBorder * 2,
     temp.Height + GiveSpaceForBorder * 2);
   Result.Canvas.Lock;
   Result.Canvas.Draw(GiveSpaceForBorder, GiveSpaceForBorder, temp);
   Result.Canvas.Unlock;
   temp.Free;
end;
 
 
// Here's to put colorfull border
procedure MakeBorder(const bdr: TBitmap; BorderWidth: Integer; BorderColor: TColor);
begin
   with bdr.Canvas do
   begin
     Brush.Style := bsClear;
     pen.Width := BorderWidth;
     pen.Color := BorderColor;
     rectangle(BorderWidth - 1, BorderWidth - 1, bdr.Width, bdr.Height);
   end;
end;
 
 
// Example how to using it
 //
 // var bmp : TBitmap;
 // begin
 //   bmp := RTFtoBitmap(RichEdit1,2);
 //   MakeBorder(bmp,2,clBlue);
 //   Image1.Canvas.Draw(5,5,bmp);
 //   bmp.free;
 // end;

Aber egal was ich versucht habe, die BitMap wird immer nur ein schwarzes Rechteck.

Zunächst ist mir die lzRichEdit.Perform-Routine immer mit einem Range Check error ausgestiegen.
Ich habe eben temporär die Bereichsprüfung ausgeschaltet, aber das verhindert halt nur den Runtime Error.

Weiß wer Rat?

ST
Christian

[pluto]

Result.Canvas.Draw(GiveSpaceForBorder, GiveSpaceForBorder, temp);

Was steht denn in "GiveSpaceForBorder" für ein Wert drin?
Sonst ändere das mal in 0,0 also das es so aussieht:
Result.Canvas.Draw(0, 0, temp);

Edit1: Mir ist erst im nachhinein das Aufruf Beispiel aufgefallen, das mit den 0,0 wird nicht die Lösung sein.

[AlterMann]

Hallo Pluto

Nein, das hab ich in meiner Version inzwischen ganz entfernt.
Ich brauch keinen Rahmen.

Bei mir sieht die Funktion inzwischen so aus (geht aber deshalb um nix besser):

Code: Alles auswählen

function TForm20.RTFtoBitmap(myRTF: TlzRichEdit): Graphics.TBitmap;
 
 
var
   myRect: TRect;
   temp: Graphics.TBitmap;
begin
   myRect := myRTF.ClientRect;
   temp := CreateEmptyBmp(clWhite, myRect.Right, myRect.Bottom);
 
   temp.Width  := myRect.Right;
   temp.Height := myRect.Bottom;
   with temp.Canvas do
   begin
     Lock;
     try
       myRTF.Perform(WM_PRINT, Handle, PRF_ERASEBKGND);
     finally
       Unlock
     end;
   end;
   Result := Graphics.TBitmap.Create;
   Result := CreateEmptyBmp(clWhite, temp.Width, temp.Height);
   Result.Canvas.Lock;
   Result.Canvas.Draw(0, 0, temp);
   Result.Canvas.Unlock;
   temp.Free;
end;
 

Ich versuche inzwischen einen anderen Weg (der wahrscheinlich letztlich auch die sauberere Lösung darstellt (wegen der verschiedenen Auflösungen zwischen Bildschirm- und Druckercanvas)):

Code: Alles auswählen

var
   i: integer;
   s : UTF8string;
   zs : string;
 
 begin
   s := lzRichEdit1.Text;
   for i := 1 to UTF8length(s) - 1 do
   begin
     if s[i] = #13 then
     with Image1.Canvas do
       MoveTo(0, PenPos.Y + TextHeight(lzRichEdit1.Lines.Strings[0]));
     lzRichEdit1.SelStart := i;
     lzRichEdit1.SelLength := 1;
     with image1.Canvas do
     begin
       Font.Color := lzRichEdit1.SelAttributes.Color;
       Font.Size := lzRichEdit1.SelAttributes.Size;
       Font.Style := lzRichEdit1.SelAttributes.Style;
       //if (s[i] <> #13) and (char(s[i]) <> #10) then
         TextOut(PenPos.X, PenPos.Y, s[i]);
         zs := s[i];
     end;
   end;
 end;
 

Nur da kämpf' ich da gerade damit, daß ein Umlaut oder ß zwei Zeichen lang ist, und somit als Einzelzeichen nicht dargestellt wird ...

[Michl]

Aber egal was ich versucht habe, die BitMap wird immer nur ein schwarzes Rechteck.

Ich habe es nicht getestet und ins Blaue geraten, doch hast du schon mal versucht das Canvas vom Bitmap, bevor du darauf zeichnest, sauber zur Verfügung zu stellen (zwei mal SomeBitmap.Canvas.Clear aufrufen)?