Suche Komponente die mir ein RTF File auf Canvas ausgibt

Klaus065 · Hält's aus hier Beiträge: 2 XP Delphi 5

Hallo,

ich möchte innerhalb eines CAD-Programmes RTF-Dateien in einer Zeichnung (auf Canvas) anzeigen.
Leider war die erste Idee das RTF-File in ein Bitmap umwandeln und dann das Bitmap darstellen nicht von erfolgt gekrönt.
(Bitmap war immer ohne Text)
Nun suche ich eine Komponente die mir aus den RTF-File entsprechende Canvas.Textout(.. Anweisungen generiert.

Vielen Dank im Voraus

Klaus065

Lannes · Verfasst: Do 22.09.05 17:23

Hallo,

ich weis nicht wie Du es versucht hast, kennst Du den Tipp?
SwissDelphiCenter: ...RichEdit in einem Bitmap übertragen?

_________________
MfG Lannes
(Nichts ist nicht Nichts) and ('' <> nil ) and (Pointer('') = nil ) and (@('') <> nil )

Klaus065 · Hält's aus hier Beiträge: 2 XP Delphi 5

******Aus SwissDelphiCenter********

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:

uses RichEdit;
// Sonic Delphi
// soulyx@yahoo.com

function CreateEmptyBmp(col,width,height : integer): TBitmap;
begin
  Result := TBitmap.create;
  Result.Canvas.Brush.color := col; // bzw. erstes Parameter...
  Result.width:= width;
  Result.Height:= height;
  ...
end;
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
      temp.SaveToFile('C:\RTF.bmp'); { Kein TEXT -> leeres BMP !!!} 
    end;
  end;
  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;


 var bmp : TBitmap;
 begin
   bmp := RTFtoBitmap(RichEdit1,2);
   MakeBorder(bmp,2,clBlue);
   Image1.Canvas.Draw(5,5,bmp);
   bmp.free;
 end;

**** Schnapp ***************************

Bitmap enthält jedoch nicht den Text !!! Ich weiss nicht weiter !!

Moderiert von AXMD: Delphi-Tags hinzugefügt.

Lannes · Verfasst: Fr 23.09.05 11:15

Hallo,

da macht mich in Deinem Code doch so einiges nachdenklich:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

//...
    finally
      Unlock
      temp.SaveToFile('C:\RTF.bmp'); { Kein TEXT -> leeres BMP !!!} 
//...

damit dürfte nicht mal ein leere bmp-Datei erzeugt werden,
denn hinter Unlock fehlt ein Semikolon und Delphi wird eine Fehlermeldung ausgeben.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

//...
    pen.Color := BorderColor;
    rectangle(BorderWidth - 1, BorderWidth - 1, bdr.Width, bdr.Height);
  end;
end;

 var bmp : TBitmap;
 begin
   bmp := RTFtoBitmap(RichEdit1,2);
   MakeBorder(bmp,2,clBlue);
   Image1.Canvas.Draw(5,5,bmp);
   bmp.free;
 end;

bei der Zeile var bmp : TBitmap; wird Delphi auch eine Fehlermeldung ausgeben.

Kann es sein das Du den Code erst garnicht zum Laufen gebracht hast,
weil Du nicht weist wie Du die Funktion in deinen Code integrieren kannst :gruebel:

Vorab, der Code von den Schweitzern läuft einwandfrei.

Also ist folgendes zu erledigen:

1. Die Unit RichEdit in uses einbinden:

markieren

Delphi-Quelltext

1:
2:
3:
4:

interface
uses
  Windows, Messages, SysUtils, Classes, 
  Graphics, Controls, Forms, Dialogs, RichEdit;

2. die Funktionen/Procedur in deine Unit kopieren:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

implementation
{$R *.DFM}
function CreateEmptyBmp(myColor : TColor; Width,Height : Integer) : TBitmap;
begin
  //...
end;

function RTFtoBitmap(myRTF: TRichEdit; GiveSpaceForBorder: Integer): TBitmap;
var
  myRect: TRect;
  temp: TBitmap;
begin
  //...
end;

procedure MakeBorder(const bdr: TBitmap; BorderWidth: Integer; BorderColor: TColor);
begin
  //...
end;

(die Funktion CreateEmptyBmp findest Du im ersten Kommentar zu dem Tipp bei den Schweitzern)

3. Die Funktion aufrufen:
Die Funktion RTFtoBitmap(myRTF: TRichEdit; GiveSpaceForBorder: Integer): TBitmap; gibt Dir als Ergebnis ein TBitmap zurück.

3.1 In einem Image ausgeben:

markieren

Delphi-Quelltext

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Canvas.Draw(5,5,RTFtoBitmap(RichEdit1,2));
end;

3.2 In einem Image mit Border ausgeben:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:

procedure TForm1.Button2Click(Sender: TObject);
var bmp : TBitmap;
begin
   bmp := RTFtoBitmap(RichEdit1,2);
   MakeBorder(bmp,2,clBlue);
   Image1.Canvas.Draw(5,5,bmp);
   bmp.free;
end;

3.3 Direkt in eine Datei speichern:

markieren

Delphi-Quelltext

1:
2:
3:
4:

procedure TForm1.Button4Click(Sender: TObject);
begin
  RTFtoBitmap(RichEdit1,2).SaveToFile('C:\temp\RTF.bmp');
end;

_________________
MfG Lannes
(Nichts ist nicht Nichts) and ('' <> nil ) and (Pointer('') = nil ) and (@('') <> nil )

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme