Bitmap aus RTF erzeugen

[Hobbycoder]

Hi,

ich möchte aus einem RTF-Text eine Bitmap mit vorgegebenen Maßen erzeugen. Der RTF-Text liegt als MemoryStream in einem Object.
Mein erster Gedanke war, mir in einer Procedure im Object temporär ein TRichEdit zu erzeugen und dann (wie hier ) mir daraus eine das ganze in ein Bitmap zu kopieren.

Delphi-Quellcode:

var
   MyRTF: TRichEdit;
begin
   self.FArbeitenBitmap.Height:=Height;
   self.FArbeitenBitmap.Width:=Width;
   MyRTF:=TRichEdit.Create(nil);
   MyRTF.Width:=Width;
   MyRTF.Height:=Height;
   Self.FArbeiten.Position:=0;
   MyRTF.Lines.LoadFromStream(self.FArbeiten);  // <---Hier knallt's dann mal

   with Self.FArbeitenBitmap.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;

Allerdings kann ich mir den Stream nicht in das RichEdit laden, weil es kein Parent hat. Parent hab ich auch nicht, weil es ja nur ein Object ist. Jetzt dachte ich mir, ich könnte ja mittels CreateWnd sowas wie ein unsichtbares Fenster erzeugen, und das Richedit damit zufrieden stellen.
Wäre das so denkbar? Wenn ja, wie macht das das? Wenn nein, wie könnte man das besser machen?

[DeddyH]

Delphi-Quellcode:

MyRTF := TRichEdit.CreateParented(HWND_MESSAGE);

sollte eigentlich funktionieren.

[Hobbycoder]

Danke, das löst schon mal der erste Problem.

Leider bekomme ich so

Delphi-Quellcode:

var
  MyRTF: TRichEdit;
  img: HDC;
begin
   self.FArbeitenBitmap.Height:=Height;
   self.FArbeitenBitmap.Width:=Width;
   MyRTF:=TRichEdit.CreateParented(HWND_MESSAGE);
   MyRTF.Width:=Width;
   MyRTF.Height:=Height;
   Self.FArbeiten.Position:=0;
   MyRTF.Lines.LoadFromStream(self.FArbeiten);

   Self.FArbeitenBitmap.Canvas.Lock;
   try
     myRTF.Perform(WM_PRINT, Self.FArbeitenBitmap.Canvas.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
     Self.FArbeitenBitmap.Canvas.Unlock
   end;

nur eine weiße Bitmap zurück.

Dann habe ich es noch mal so

Delphi-Quellcode:

var
  MyRTF: TRichEdit;
  img: HDC;
begin
   self.FArbeitenBitmap.Height:=Height;
   self.FArbeitenBitmap.Width:=Width;
   MyRTF:=TRichEdit.CreateParented(HWND_MESSAGE);
   MyRTF.Width:=Width;
   MyRTF.Height:=Height;
   Self.FArbeiten.Position:=0;
   MyRTF.Lines.LoadFromStream(self.FArbeiten);

   img := GetDC(MyRTF.Handle);
   BitBlt(Self.FArbeitenBitmap.Canvas.Handle,
     0, 0, MyRTF.Width, MyRTF.Height,
     img, 0, 0,
     SRCCOPY
   );

versucht, bekomme aber eine schwarze Bitmap.
Im Stream ist aber definitiv das richtige drin, den wenn ich mir das in ein Richedit lade, dass auf der Form liegt, wird es korrekt angezeigt.

Hast du da auch noch einen Tipp? Geht das so, außerhalb einer Form, überhaupt?

[nahpets]

Mein Vorgehen wäre hier eher von der faulen und uneleganten Sorte:

Wenn zur Laufzeit ein TRichEdit erstellt wird und das braucht ein Formular, auf dem es liegt, dann wird das eben auch erzeugt, Visible := False, damit der Anwender da nicht genervt wird.

Musste mal was ähnliches mit 'nem TChart in 'ner ISAPI.DLL machen, hat problemlos funktioniert. Vom TChart wurde auch nur das damit erstellte Bitmap benötigt. Und 'ne ISAPI.DLL mit 'nem Formular ist eher äußerst ungewöhnlich bzw. eigentlich vollkommen unsinnig.

[Hobbycoder]

Habe ich grad mal versucht...keine Änderung.

Folgende Code funktioniert auf dem Formular und liefert mir eine Bitmap siehe Anhang 1:

Delphi-Quellcode:

var
  img: HDC;
begin
   richedit1.Lines.LoadFromStream(t.Arbeiten);
   t.ArbeitenBitmap.Height:=richedit1.Height;
   t.ArbeitenBitmap.Width:=richedit1.Width;
   img := GetDC(richedit1.Handle);
   BitBlt(t.ArbeitenBitmap.Canvas.Handle,
     0, 0, richedit1.Width, richedit1.Height,
     img, 0, 0,
     SRCCOPY
   );
   t.ArbeitenBitmap.SaveToFile(ExtractFilePath(Application.ExeName)+'arbeiten.bmp');

Und folgender Code im Object funktioniert nicht und liefert mir eine Bitmap siehe Anhang 2:

Delphi-Quellcode:

var
  MyRTF: TRichEdit;
  frm: TForm;
  img: HDC;
begin
   self.FArbeitenBitmap.Height:=Height;
   self.FArbeitenBitmap.Width:=Width;
   frm:=TForm.Create(Application);
   try
     //MyRTF:=TRichEdit.CreateParented(HWND_MESSAGE);
     MyRTF:=TRichEdit.Create(frm);
     Try
     MyRTF.Parent:=frm;
     MyRTF.Width:=Height;
     MyRTF.Height:=Width;
     Self.FArbeiten.Position:=0;
     MyRTF.Lines.LoadFromStream(self.FArbeiten);
     img := GetDC(MyRTF.Handle);
     BitBlt(Self.FArbeitenBitmap.Canvas.Handle,
       0, 0, MyRTF.Width, MyRTF.Height,
       img, 0, 0,
       SRCCOPY
     );
     finally
      MyRTF.free;
     End;
   finally
     frm.free;
   end;

Sollte doch eigentlich gehen. Woran kann das liegen?

Man kann das zweite Bild unten leder nicht so richtig sehen, ist aber da. Ist halt komplett weiß ;-)
Das linke Bild ist Anhang 1 und das rechte ist Anhang 2.

[nahpets]

Kann gerade nicht testen, kein Delphi in der Nähe :-(

Gibt dem Formular bitte mal 'ne Höhe und Breite, die der des gewünschten Bitmaps plus Höhe von Caption, Border ... des Forms entspricht und mach' das Formular erstmal sichtbar, um so eine "quasioptische" Kontrolle zu haben, ob überhaupt was zu sehen ist.

[Hobbycoder]

Hab ich gemacht:

Delphi-Quellcode:

var
  MyRTF: TRichEdit;
  frm: TForm;
  img: HDC;
begin
   self.FArbeitenBitmap.Height:=Height;
   self.FArbeitenBitmap.Width:=Width;
   frm:=TForm.Create(Application);
   try
     frm.Width:=Width+50;
     frm.Height:=Height+80;
     //MyRTF:=TRichEdit.CreateParented(HWND_MESSAGE);
     MyRTF:=TRichEdit.Create(frm);
     Try
     MyRTF.Left:=10;
     MyRTF.Top:=20;
     MyRTF.Parent:=frm;
     MyRTF.Width:=Width;
     MyRTF.Height:=Height;
     frm.Visible:=True;
     Self.FArbeiten.Position:=0;
     MyRTF.Lines.LoadFromStream(self.FArbeiten);
     img := GetDC(MyRTF.Handle);
     BitBlt(Self.FArbeitenBitmap.Canvas.Handle,
       0, 0, MyRTF.Width, MyRTF.Height,
       img, 0, 0,
       SRCCOPY
     );
     finally
      //MyRTF.free;
     End;
   finally
     //frm.free;
   end;

Formular erscheint. RichEdit ist drauf und Text im Richedit ist korrekt.
Bitmap ist aber trotzdem nur weiß. Erklären kann ich mir das nicht.

[Hobbycoder]

Hab aber grad heraus gefunden, dass, wenn ich nach dem LoadFromStream ein Applicaiton.processMessages mache, dann wird die Bitmap korrekt erstellt ;-)

Nur ein Application.ProcessMessages in einem Object......ist nicht wirklich eine gute Idee.

Wie kann ich dem RichEdit sage, dass es seinen geladenen Stream aufbereiten soll, damit ich danach das Bitmap erstellen kann?

[Edit] und wenn ich das Visible für die frm wieder rausnehme, ist meine Bitmap wieder schwarz :-( [/Edit]

[nahpets]

Blöd das Ganze:

Left des Formulars auf -1000 oder sowas setzen, dann kann es sichtbar bleiben, ist aber außerhalb des sichtbaren Bereiches.

Kann RichEdit Repaint, Update oder sowas?

Weiß, meine Vorschläge sind irgendwie wieder grenzwertig, zumindest mir gefallen sie nicht :-(

[HolgerX]

Hmm..

Hab mal nen bischen gegooglet und zusmmengeschripselt:
(Vergessen die Quellen zu notieren.. )

Delphi-Quellcode:

uses
  Windows, Classes, Graphics, ComCtrls, RichEdit;

procedure DrawRTF(DestDCHandle: HDC; const R: TRect;
  RichEdit: TRichEdit; PixelsPerInch: Integer);
var
  TwipsPerPixel: Integer;
  Range: TFormatRange;
begin
  TwipsPerPixel := 1440 div PixelsPerInch;

  Range.hDC := DestDCHandle; {DC handle}
  Range.hdcTarget := DestDCHandle; {ditto}
  {Convert the coordinates to twips (1/1440")}
  Range.rc.Left := R.Left * TwipsPerPixel;
  Range.rc.Top := R.Top * TwipsPerPixel;
  Range.rc.Right := R.Right * TwipsPerPixel;
  Range.rc.Bottom := R.Bottom * TwipsPerPixel;
  Range.rcPage := Range.rc;
  {Start at character zero}
  Range.chrg.cpMin := 0;
  {Display all Characters}
  Range.chrg.cpMax := -1; {RichEdit.GetTextLen;}
  {Free cached information}
  RichEdit.Perform(EM_FORMATRANGE, 0, 0);
  {First measure the text, to find out how high the format rectangle will be.
  The call sets fmtrange.rc.bottom to the actual height required, if all
  characters in the selected range will fit into a smaller rectangle}
  RichEdit.Perform(EM_FORMATRANGE, 0, DWord(@Range));
  {Now render the text}
  RichEdit.Perform(EM_FORMATRANGE, 1, DWord(@Range));
  {Free cached information}
  RichEdit.Perform(EM_FORMATRANGE, 0, 0);
end;


procedure RTFToBmp(MainWND : HWND;AFileName : string;var ABitMap : TBitmap);
var
  RichEdit: TRichEdit;
  DestDCHandle: HDC;
begin
  RichEdit :=TRichEdit.CreateParented(MainWND);
  try
    RichEdit.Width := GetDeviceCaps(GetDC(RichEdit.Handle),VERTRES);
    RichEdit.Height := GetDeviceCaps(GetDC(RichEdit.Handle),HORZRES);

    RichEdit.Visible := False;
    RichEdit.Lines.LoadFromFile(AFileName);

    ABitMap.width := RichEdit.Width;
    ABitMap.height := RichEdit.Height;
    DestDCHandle := ABitMap.Canvas.Handle;

    DrawRTF(DestDCHandle, Rect(0, 0, ABitMap.Width, ABitMap.Height), RichEdit, 96);
  finally
    RichEdit.Free;
  end;
end;

Aufruf:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  tmpBMP : TBitMap;
begin
  if OpenDialog1.Execute then begin
    tmpBMP := TBitMap.Create;
    try
      RTFToBmp(self.Handle,OpenDialog1.FileName,tmpBMP);
      Image1.Picture.Assign(tmpBMP);
    finally
      tmpBMP.Free;
    end;
  end;
end;

Damit erhalte ich ein Bitmap der ersten Seite des RTF Dokumentes...

(Getestet mit D6...)