I want to print Right-to-left Unicode strings on a Canvas. I can't find a BidiMode property or something like that to get it done.
currently the symbols which are located at the end of strings, appear before the first character of the text which is printed on the Canvas.
FMX
FireMonkey does not have any BiDi capabilities at this time.
VCL
The Vcl.TControl class has public DrawTextBiDiModeFlags() and DrawTextBiDiModeFlagsReadingOnly() methods, which help the control decide the appropriate BiDi flags to specify when calling the Win32 API DrawText() function.
In Vcl.Graphics.TCanvas, its TextOut() and TextRect() methods do not use the Win32 API DrawText() function, they use the Win32 API ExtTextOut() function instead, where the value of the TCanvas.TextFlags property is passed to the fuOptions parameter of ExtTextOut(). The TextFlags property also influences the value of the TCanvas.CanvasOrientation property, which TextOut() and TextRect() use internally to adjust the X coordinate of the drawing.
For right-to-left drawing with TCanvas, include the ETO_RTLREADING flag in the TextFlags property.
Had no success to display RTL text with "TextOut" when form bidimode is set to "bdLeftToRight", so I usually used
XXX.Canvas.TextRect(Rect,Text,[tfRtlReading,tfRight]);
Worked very well for me..
I needed to detect Hebrew, so I did it like this:
function CheckHebrew(s: string): boolean;
var
i: Integer;
begin
Result := false;
for i := 1 to Length(s) do
if (ord(s[i])>=1424) and (ord(s[i])<1535) then
begin
Result := true;
exit;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
tf : TTextFormat;
r : TRect;
s : string;
begin
r.Left := 0;
r.Top := 0;
r.Width := Image1.Width;
r.Height := Image1.Height;
s := Edit1.Text;
if CheckHebrew(s) then
tf := [tfRtlReading,tfRight,tfWordBreak]
else
tf := [tfWordBreak];
Image1.Canvas.FillRect(r);
Image1.Canvas.TextRect(r,s,tf)
end;
Related
Need a component derived from TMemo (not TSyn components)
I need a line to the left(inside or outside) of a TMemo whose thickness(optional) and color can be controlled just for the purposes of indication. It need not be functional as a gutter but looks like one especially like that of a SynMemo as shown in the image. The problem with SynMemo is that it doesn't support variable width fonts like Tahoma but the TMemo does.
I tried making a few composite components with CustomContainersPack by combining a TShape with TMemo, even superimposing a TMemo on top of TSynMemo but didn't succeed as the paint while dragging made it look disassembled and CCPack is not that robust for my IDE.
KMemo, JvMemo and many other Torry.net components were installed and checked for any hidden support for achieving the same but none worked.
Grouping of components together is also not a solution for me since many mouse events are tied to the Memo and calls to FindVCLWindow will return changing components under the mouse. Furthermore many components will be required so grouping with TPanel will up the memory usage.
You can use the WM_Paint message and a hack to do this without creating a new component,
Otherwise create a descendant of TMemo and apply the same changes below
TMemo = class(Vcl.StdCtrls.TMemo)
private
FSidecolor: TColor;
FSideColorWidth: Integer;
FAskForAttention: Boolean;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure SetSideColorWidth(const Value: Integer);
procedure SetSideColor(const Value: TColor);
procedure SetAskForAttention(const Value: Boolean);
published
property SideColor: TColor read FSideColor write SetSideColor default clRed;
property SideColorWidth: Integer read FSideColorWidth write SetSideColorWidth default 2;
property AskForAttension: Boolean read FAskForAttention write SetAskForAttention;
end;
{ TMemo }
procedure TMemo.SetAskForAttention(const Value: Boolean);
begin
FAskForAttention := Value;
Invalidate;
end;
procedure TMemo.SetSideColor(const Value: TColor);
begin
FSideColor := Value;
Invalidate;
end;
procedure TMemo.SetSideColorWidth(const Value: Integer);
begin
FSideColorWidth := Value;
Invalidate;
end;
procedure TMemo.WMPaint(var Message: TWMPaint);
var
DC: HDC;
Pen: HPen;
R,G,B: Byte;
begin
inherited;
if FAskForAttention then
begin
DC := GetWindowDC(Handle);
try
B := Byte(FSidecolor);
G := Byte(FSidecolor shr 8);
R := Byte(FSidecolor shr 16);
Pen := CreatePen(PS_SOLID, FSideColorWidth, RGB(R,G,B));
SelectObject(DC, Pen);
SetBkColor(DC, RGB(R,G,B));
Rectangle(DC, 1, 1, FSideColorWidth, Height - 1);
DeleteObject(Pen);
finally
ReleaseDC(Handle, DC);
end;
end;
end;
And you can use it like this
procedure TForm15.Button1Click(Sender: TObject);
begin
memo1.SideColor := ColorBox1.Selected;
memo1.SideColorWidth := 2;
memo1.AskForAttension := True;
end;
and you get this result
Limitations:
As this is merely another hack to draw a simple rectangle on the side, do not expect it to be perfect on all situations. I did notice the following when testing:
If the border is too thick you get the following effect
When on mouse move the line sometimes disappear and don't get painted (I think it is because of drawing focus rect).
Note: I see the guys in comments suggested to create a custom component with panel and memo put together, If you want to try this, take a look at my answer to
Creating a new components by combining two controls (TEdit and TTrackBar) in Delphi VCL
It is basically the same Ideas.
Edit:
Ok I took into consideration what is mentioned in comments and adapted my answer,
I also changed the way I'm getting the canvas of the component. The new implementation becomes this
{ TMemo }
procedure TMemo.SetAskForAttention(const Value: Boolean);
var
FormatRect: TRect;
begin
if FAskForAttention <> Value then
begin
FAskForAttention := Value;
if not FAskForAttention then
begin
Perform(EM_SETRECT, 0, nil);
end
else
begin
FormatRect := GetClientRect;
if IsRightToLeft then
FormatRect.Right := FormatRect.Right - FSideColorWidth - 3
else
FormatRect.Left := FormatRect.Left + FSideColorWidth + 3;
Perform(EM_SETRECT, 0, FormatRect);
end;
Invalidate;
end;
end;
procedure TMemo.SetSideColor(const Value: TColor);
begin
if FSideColor <> Value then
begin
FSideColor := Value;
Invalidate;
end;
end;
procedure TMemo.SetSideColorWidth(const Value: Integer);
var
FormatRect: TRect;
begin
if FSideColorWidth <> Value then
begin
FSideColorWidth := Value;
FormatRect := GetClientRect;
if IsRightToLeft then
FormatRect.Right := FormatRect.Right - FSideColorWidth - 3
else
FormatRect.Left := FormatRect.Left + FSideColorWidth + 3;
Perform(EM_SETRECT, 0, FormatRect);
end;
end;
procedure TMemo.WMPaint(var Message: TWMPaint);
var
Canvas: TControlCanvas;
CRect: TRect;
begin
inherited;
if FAskForAttention then
begin
Canvas := TControlCanvas.Create;
try
Canvas.Control := Self;
Canvas.Font.Assign(Self.Font);
CRect := GetClientRect;
if IsRightToLeft then
CRect.Left := CRect.Right - FSideColorWidth
else
CRect.Width := FSideColorWidth;
Canvas.Brush.Color := FSidecolor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(CRect);
finally
Canvas.Free;
end;
end;
end;
There is no limitations for the size and it does not overlap the scrollbars.
Final result:
References I used to write this answer:
MSDN Painting and Drawing Functions
MSDN Using the WM_PAINT Message
Creating Colored Pens and Brushes example
Vcl.Controls TWinControl WM_Paint message implementation
EM_SETRECT message
How can I get a TEdit's canvas in Delphi? (Kobik's answer)
Instead of writing a custom control, put a panel or a shape beside the standard memo and give it any colour you like.
If this is too tedious to repeat many times, then put the memo and the shape on a frame and put that in the repository. Set the anchors to make sure they resize correctly. You don't even need to write code for that and you have an instant "imitation custom control".
Much better and simpler than writing, installing and testing a custom control, IMO.
Now if you want to put text or numbers or icons in the gutter, then it would pay out to write a custom control. Use EM_SETRECT to set the internal formatting rectangle, and custom draw the gutter in the overridden Paint method. Do not forget to call inherited.
I want to draw on a canvas a word vertically and next to it a word horizontally.
I used a old suggestion like this :
in the maiForm's create event :
GetObject(MainForm.Font.Handle,SizeOf(TLogFont),#LogFont);
NewLogFont := LogFont;
NewLogFont.lfEscapement := 900;
NewFont := CreateFontIndirect(NewLogFont);
OldFont := MainForm.Font.Handle;
where
LogFont,NewLogFont : TLogFont;
NewFont,OldFont : HFont;
and in drawing routine :
fontTemp := TFont.Create;
fontTemp.Assign(aCanvas.Font);
......
aCanvas.Font.Handle := newFont; // if i coment this line the two strings drawn verically else both drawn horizonatlly
aCanvas.Font.Size := 8;
h := textHeight('1');
aCanvas.textOut(x,y,aString);
aCanvas.Font.Assign(fontTemp);
aCanvas.textOut(x+20,y,bString);
.....
fontTemp.Free;
In my old application (D2007) it worked ok but in Delphi 10.2, the change of orientation (from vert to horiz) changes both strings to horiz.
Any help please ?
No, as you said it is not an absolutely rare code. This approach lets you rotate text without using VCL's canvas properties.
Pure WinAPI for output text with rotation
The code below uses no VCL's capabilities to output rotated text onto provided device context (HDC).
procedure TForm1.DrawTextRotatedA(ADC: HDC; AFontHandle: HFONT;
Angle, X, Y: Integer; AColor: COLORREF; AText: String);
var
LogFont: tagLOGFONT;
OldFontHandle: HFONT;
NewFontHandle: HFONT;
begin
if (ADC = 0) or (AFontHandle = 0) then
Exit;
if GetObject(AFontHandle, SizeOf(LogFont), #LogFont) = 0 then
Exit;
// Set color of text and its rotation angle
SetTextColor(ADC, AColor);
if Angle > 360 then
Angle := 0;
LogFont.lfEscapement := Angle * 10;
LogFont.lfCharset := 1;
LogFont.lfOutPrecision := OUT_TT_PRECIS;
LogFont.lfQuality := PROOF_QUALITY;
// Create new font
NewFontHandle := CreateFontIndirect(LogFont);
try
OldFontHandle := SelectObject(ADC, NewFontHandle);
try
// Output result
SetBKMode(ADC, TRANSPARENT);
try
TextOut(ADC, X, Y, LPCWSTR(AText), Length(AText));
finally
SetBKMode(ADC, OPAQUE);
end;
finally
// Restore font handle
NewFontHandle := SelectObject(ADC, OldFontHandle);
end;
finally
// Delete font handle
DeleteObject(NewFontHandle);
end;
end;
There are places for improvements but this is just an example to prove you are wrong calling such a code rare. This example expects HFONT as one of arguments to perform all actions over it. You probably could get font handle from TControl by using WM_GETFONT message, but most of VCL's components don't honor this message (it works, f.e. with TListView which returns correct font handle). Trying to get font handle from HDC returns System font that doesn't support rotation at all. Perhaps I did something wrong but I have acted accordingly to microsoft.docs.
Using VCL for output text with rotation
I didn't get what code you have provide in your question should to do (it is cannot be compiled) so I rewrite it to show you how to output rotated text with using VCL's capabilities.
procedure TForm1.DrawTextRotatedB(ACanvas: TCanvas; Angle, X, Y: Integer;
ATextColor: TColor; AText: String);
var
NewX: Integer;
NewY: integer;
Escapement: Integer;
LogFont: TLogFont;
NewFontHandle: HFONT;
OldFontHandle: HFONT;
begin
if not Assigned(ACanvas) then
Exit;
// Get handle of font and prepare escapement
GetObject(ACanvas.Font.Handle, SizeOf(LogFont), #LogFont);
if Angle > 360 then
Angle := 0;
Escapement := Angle * 10;
// We must initialise all fields of the record structure
LogFont.lfWidth := 0;
LogFont.lfHeight := ACanvas.Font.Height;
LogFont.lfEscapement := Escapement;
LogFont.lfOrientation := 0;
if fsBold in ACanvas.Font.Style then
LogFont.lfWeight := FW_BOLD
else
LogFont.lfWeight := FW_NORMAL;
LogFont.lfItalic := Byte(fsItalic in ACanvas.Font.Style);
LogFont.lfUnderline := Byte(fsUnderline in ACanvas.Font.Style);
LogFont.lfStrikeOut := Byte(fsStrikeOut in ACanvas.Font.Style);
LogFont.lfCharSet := ACanvas.Font.Charset;
LogFont.lfOutPrecision := OUT_DEFAULT_PRECIS;
LogFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
LogFont.lfQuality := DEFAULT_QUALITY;
LogFont.lfPitchAndFamily := DEFAULT_PITCH;
StrPCopy(LogFont.lfFaceName, ACanvas.Font.Name);
// Create new font with rotation
NewFontHandle := CreateFontIndirect(LogFont);
try
// Set color of text
ACanvas.Font.Color := ATextColor;
// Select the new font into the canvas
OldFontHandle := SelectObject(ACanvas.Handle, NewFontHandle);
try
// Output result
ACanvas.Brush.Style := VCL.Graphics.bsClear;
try
ACanvas.TextOut(X, Y, AText);
finally
ACanvas.Brush.Style := VCL.Graphics.bsSolid;
end;
finally
// Restore font handle
NewFontHandle := SelectObject(ACanvas.Handle, OldFontHandle);
end;
finally
// Delete the deselected font object
DeleteObject(NewFontHandle);
end;
end;
Using case
Here is the code showing how to use procedures for rotating text.
procedure TForm1.aButton1Click(Sender: TObject);
var
DC: HDC;
begin
Repaint;
DC := GetDC(Handle);
try
DrawTextRotatedA(DC, Canvas.Font.Handle, TrackBar1.Position, 100, 100, clNavy, 'String');
finally
ReleaseDC(Handle, DC);
end;
DrawTextRotatedB(Canvas, TrackBar1.Position, 200, 100, clNavy, 'String');
end;
Sometimes it is faster to output rotated text onto DC without VCL. This could be useful if you are trying to deal with control that have no access to canvas. F.e. if you will try to paint tooltip (tooltip_class32) in your own style you probably might want to use the first method to output text (rotated or not).
Information
Here are links from docs.microsoft. they describe how and why one or another function was used.
About Device Contexts
TextOutW function
SetTextColor function
tagLOGFONTW structure
GetObject function
WM_GETFONT message
It's simple!
TFont has the property orientation that does the work! All this stuf I used is absolutely rare.
How can I limit the maximum text length of the inplace editor in TDBGrid? (Delphi Berlin)
The Data Type is Float.
The inplace editor in a TDBGrid will update its content by calling
procedure TInplaceEdit.UpdateContents;
begin
Text := '';
EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
Text := Grid.GetEditText(Grid.Col, Grid.Row);
MaxLength := Grid.GetEditLimit;
end;
Where GetEditMask is implemented the following way:
function TCustomDBGrid.GetEditMask(ACol, ARow: Longint): string;
begin
Result := '';
if FDatalink.Active then
with Columns[RawToDataColumn(ACol)] do
if Assigned(Field) then
Result := Field.EditMask;
end;
and GetEditLimit like this:
function TCustomDBGrid.GetEditLimit: Integer;
begin
Result := 0;
if Assigned(SelectedField) and (SelectedField.DataType in [ftString, ftWideString]) then
Result := SelectedField.Size;
end;
There you have multiple ways to get to the desired behavior I think.
Use TField EditMask property for the Field you want to restrict. This will be returned by Grid.GetEditMask call. No need to inherit from TDBGrid and override anything. Behavior can be controlled on a by-field-basis.
Create your own TDBGrid descendant where you override GetEditLimit
to return a MaxLength for the inplace editor depending on SelectedField
Code for approach 1 could look like this:
// Opening of dataset
...
DataSet.FieldByName('FloatField').EditMask := '00.00';
This will mask will require two digits before and after the decimal seperator. See TEditMask for more on masks.
For approach 2:
uses
Data.DB,
Vcl.DBGrids;
type
TMyDBGrid = class(TDBGrid)
protected
function GetEditLimit: Integer; override;
end;
implementation
{ TMyDBGrid }
function TMyDBGrid.GetEditLimit: Integer;
begin
Result := inherited GetEditLimit;
if (Result = 0) and Assigned(SelectedField) and (SelectedField.DataType = ftFloat) then
Result := 5; // Whatever you decide
end;
Like kobik suggests, you can then use this class as interposer class. To do this, add TDBGrid = class(TMyDBGrid); in the unit you want to use that grid. If you declared TMyDBGrid in the same unit you want to use it, make the type reference clear TMyDBGrid = class(Vcl.DBGrids.TDBGrid).
I need to use a TRichEdit at runtime to perform the rtf to text conversion as discussed here. I succeded in doing this but I had to set a dummy form as parent if not I cannot populate the TRichedit.Lines. (Error: parent is missing).
I paste my funciton below, can anyone suggest a way to avoid to define a parent? Can you also comment on this and tell me if you find a more performant idea?
Note: I need a string, not TStrings as output, this is why it has been designed like this.
function RtfToText(const RTF: string;ReplaceLineFeedWithSpace: Boolean): string;
var
RTFConverter: TRichEdit;
MyStringStream: TStringStream;
i: integer;
CustomLineFeed: string;
begin
if ReplaceLineFeedWithSpace then
CustomLineFeed := ' '
else
CustomLineFeed := #13;
try
RTFConverter := TRichEdit.Create(nil);
try
MyStringStream := TStringStream.Create(RTF);
RTFConverter.parent := Form4; // this is the part I don't like
RTFConverter.Lines.LoadFromStream(MyStringStream);
RTFConverter.PlainText := True;
for i := 0 to RTFConverter.Lines.Count - 1 do
begin
if i < RTFConverter.Lines.Count - 1 then
Result := Result + RTFConverter.Lines[i] + CustomLineFeed
else
Result := Result + RTFConverter.Lines[i];
end;
finally
MyStringStream.Free;
end;
finally
RTFConverter.Free;
end;
end;
UPDATE:
After the answer I updated the function and write it here for reference:
function RtfToText(const RTF: string;ReplaceLineFeedWithSpace: Boolean): string;
var
RTFConverter: TRichEdit;
MyStringStream: TStringStream;
begin
RTFConverter := TRichEdit.CreateParented(HWND_MESSAGE);
try
MyStringStream := TStringStream.Create(RTF);
try
RTFConverter.Lines.LoadFromStream(MyStringStream);
RTFConverter.PlainText := True;
RTFConverter.Lines.StrictDelimiter := True;
if ReplaceLineFeedWithSpace then
RTFConverter.Lines.Delimiter := ' '
else
RTFConverter.Lines.Delimiter := #13;
Result := RTFConverter.Lines.DelimitedText;
finally
MyStringStream.Free;
end;
finally
RTFConverter.Free;
end;
end;
TRichEdit control is an wrapper around the RichEdit control in Windows. Windows's controls are... well.. Windows, and they need an Window Handle to work. Delphi needs to call CreateWindow or CreateWindowEx to create the Handle, and both routines need an valid parent Window Handle to work. Delphi tries to use the handle of the control's parent (and it makes sense!). Happily one can use an alternative constructor (the CreateParanted(HWND) constructor) and the nice people at Microsoft made up the HWND_MESSAGE to be used as parent for windows that don't actually need a "window" (messaging-only).
This code works as expected:
procedure TForm2.Button2Click(Sender: TObject);
var R:TRichEdit;
L:TStringList;
begin
R := TRichEdit.CreateParented(HWND_MESSAGE);
try
R.PlainText := False;
R.Lines.LoadFromFile('C:\Temp\text.rtf');
R.PlainText := True;
Memo1.Lines.Text := R.Lines.Text;
finally
R.Free;
end;
end;
This is part of the way the VCL works, and you're not going to get it to work differently without some heavy workarounds. But you don't need to define a dummy form to be the parent; just use your current form and set visible := false; on the TRichEdit.
If you really want to improve performance, though, you could throw out that loop you're using to build a result string. It has to reallocate and copy memory a lot. Use the Text property of TrichEdit.Lines to get a CRLF between each line, and DelimitedText to get somethimg else, such as spaces. They use an internal buffer that's only allocated once, which will speed up the concatenation quite a bit if you're working with a lot of text.
I use DrawRichText to draw RTF without a RichEdit control. (IIRC this is called Windowless Rich Edit Controls.) Maybe you can use this also for converting - however I have never tried this.
This has been the most helpfull for me to get started with TRichEdit, but not with the conversion. This however works as expected and you don't need to set the Line Delimiter:
// RTF to Plain:
procedure TForm3.Button1Click(Sender: TObject);
var
l:TStringList;
s:WideString;
RE:TRichEdit;
ss:TStringStream;
begin
ss := TStringStream.Create;
s := Memo1.Text; // Input String
RE := TRichEdit.CreateParented(HWND_MESSAGE);
l := TStringList.Create;
l.Add(s);
ss.Position := 0;
l.SaveToStream(ss);
ss.Position := 0;
RE.Lines.LoadFromStream(ss);
Memo2.Text := RE.Text; // Output String
end;
// Plain to RTF:
procedure TForm3.Button2Click(Sender: TObject);
var
RE:TRichEdit;
ss:TStringStream;
begin
RE := TRichEdit.CreateParented(HWND_MESSAGE);
RE.Text := Memo2.Text; // Input String
ss := TStringStream.Create;
ss.Position := 0;
RE.Lines.SaveToStream(ss);
ss.Position := 0;
Memo1.Text := ss.ReadString(ss.Size); // Output String
end;
I'm using the TStringList "l" in the conversion to plain because somehow the TStringStream puts every single character in a new line.
Edit: Made the code a bit nicer and removed unused variables.
I need to use a TRichEdit at runtime to perform the rtf to text conversion as discussed here. I succeded in doing this but I had to set a dummy form as parent if not I cannot populate the TRichedit.Lines. (Error: parent is missing).
I paste my funciton below, can anyone suggest a way to avoid to define a parent? Can you also comment on this and tell me if you find a more performant idea?
Note: I need a string, not TStrings as output, this is why it has been designed like this.
function RtfToText(const RTF: string;ReplaceLineFeedWithSpace: Boolean): string;
var
RTFConverter: TRichEdit;
MyStringStream: TStringStream;
i: integer;
CustomLineFeed: string;
begin
if ReplaceLineFeedWithSpace then
CustomLineFeed := ' '
else
CustomLineFeed := #13;
try
RTFConverter := TRichEdit.Create(nil);
try
MyStringStream := TStringStream.Create(RTF);
RTFConverter.parent := Form4; // this is the part I don't like
RTFConverter.Lines.LoadFromStream(MyStringStream);
RTFConverter.PlainText := True;
for i := 0 to RTFConverter.Lines.Count - 1 do
begin
if i < RTFConverter.Lines.Count - 1 then
Result := Result + RTFConverter.Lines[i] + CustomLineFeed
else
Result := Result + RTFConverter.Lines[i];
end;
finally
MyStringStream.Free;
end;
finally
RTFConverter.Free;
end;
end;
UPDATE:
After the answer I updated the function and write it here for reference:
function RtfToText(const RTF: string;ReplaceLineFeedWithSpace: Boolean): string;
var
RTFConverter: TRichEdit;
MyStringStream: TStringStream;
begin
RTFConverter := TRichEdit.CreateParented(HWND_MESSAGE);
try
MyStringStream := TStringStream.Create(RTF);
try
RTFConverter.Lines.LoadFromStream(MyStringStream);
RTFConverter.PlainText := True;
RTFConverter.Lines.StrictDelimiter := True;
if ReplaceLineFeedWithSpace then
RTFConverter.Lines.Delimiter := ' '
else
RTFConverter.Lines.Delimiter := #13;
Result := RTFConverter.Lines.DelimitedText;
finally
MyStringStream.Free;
end;
finally
RTFConverter.Free;
end;
end;
TRichEdit control is an wrapper around the RichEdit control in Windows. Windows's controls are... well.. Windows, and they need an Window Handle to work. Delphi needs to call CreateWindow or CreateWindowEx to create the Handle, and both routines need an valid parent Window Handle to work. Delphi tries to use the handle of the control's parent (and it makes sense!). Happily one can use an alternative constructor (the CreateParanted(HWND) constructor) and the nice people at Microsoft made up the HWND_MESSAGE to be used as parent for windows that don't actually need a "window" (messaging-only).
This code works as expected:
procedure TForm2.Button2Click(Sender: TObject);
var R:TRichEdit;
L:TStringList;
begin
R := TRichEdit.CreateParented(HWND_MESSAGE);
try
R.PlainText := False;
R.Lines.LoadFromFile('C:\Temp\text.rtf');
R.PlainText := True;
Memo1.Lines.Text := R.Lines.Text;
finally
R.Free;
end;
end;
This is part of the way the VCL works, and you're not going to get it to work differently without some heavy workarounds. But you don't need to define a dummy form to be the parent; just use your current form and set visible := false; on the TRichEdit.
If you really want to improve performance, though, you could throw out that loop you're using to build a result string. It has to reallocate and copy memory a lot. Use the Text property of TrichEdit.Lines to get a CRLF between each line, and DelimitedText to get somethimg else, such as spaces. They use an internal buffer that's only allocated once, which will speed up the concatenation quite a bit if you're working with a lot of text.
I use DrawRichText to draw RTF without a RichEdit control. (IIRC this is called Windowless Rich Edit Controls.) Maybe you can use this also for converting - however I have never tried this.
This has been the most helpfull for me to get started with TRichEdit, but not with the conversion. This however works as expected and you don't need to set the Line Delimiter:
// RTF to Plain:
procedure TForm3.Button1Click(Sender: TObject);
var
l:TStringList;
s:WideString;
RE:TRichEdit;
ss:TStringStream;
begin
ss := TStringStream.Create;
s := Memo1.Text; // Input String
RE := TRichEdit.CreateParented(HWND_MESSAGE);
l := TStringList.Create;
l.Add(s);
ss.Position := 0;
l.SaveToStream(ss);
ss.Position := 0;
RE.Lines.LoadFromStream(ss);
Memo2.Text := RE.Text; // Output String
end;
// Plain to RTF:
procedure TForm3.Button2Click(Sender: TObject);
var
RE:TRichEdit;
ss:TStringStream;
begin
RE := TRichEdit.CreateParented(HWND_MESSAGE);
RE.Text := Memo2.Text; // Input String
ss := TStringStream.Create;
ss.Position := 0;
RE.Lines.SaveToStream(ss);
ss.Position := 0;
Memo1.Text := ss.ReadString(ss.Size); // Output String
end;
I'm using the TStringList "l" in the conversion to plain because somehow the TStringStream puts every single character in a new line.
Edit: Made the code a bit nicer and removed unused variables.