Problem appending to a TMemoryStream using SaveToStream...

Hello experts, I'm trying to append the contents of multiple TRichEdits to a TMemoryStream and I just can't get it. I tried this simple test to write the text string 'Here is some text' 2 times back-to-back to the TMemoryStream, but it only outputs it once - either that or it just overwrites the second time around.

  //********TEST*******//

  REPORTSTREAM:= TMemoryStream.Create;
  REPORTSTREAM.Clear;

  HRE:= TRichEdit.Create(nil);
  HRE.Visible:= False;
  HRE.Parent:= self;
  HRE.text := 'Here is some text';

  HRE.Lines.SaveToStream(REPORTSTREAM);      // Save the text to the stream
  REPORTSTREAM.Position:= REPORTSTREAM.Seek(0, soFromEnd);    // Should move the position to the end of the stream?
  HRE.Lines.SaveToStream(REPORTSTREAM);      // Save the text again to the stream

  RichRpt:= TRichEdit.Create(nil);
  RichRpt.Visible:= False;
  RichRpt.Parent:= self;

  REPORTSTREAM.Seek(0, soFromBeginning);
  RichRpt.Lines.LoadFromStream(REPORTSTREAM);

  RichRpt.Lines.SaveToFile(homedir+'Report.rtf');
  RichRpt.Free;
  HRE.FREE;
  REPORTSTRING.Free;
  REPORTSTREAM.Free;

  //****** END TEST ******//

Open in new window



You would expect the contents of the file 'Report.rtf' to be:

Here is some text
Here is some text

But it's only:

Here is some text


Can anyone point out where I'm going wrong please?

Thanks!
    Shawn
shawn857Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Sinisa VukCommented:
Some time ago I propose to use this function....

So zour code should be then>
REPORTSTREAM:= TMemoryStream.Create;
  REPORTSTREAM.Clear;

  HRE:= TRichEdit.Create(nil);
  HRE.Visible:= False;
  HRE.Parent:= self;
  HRE.text := 'Here is some text';

  RichRpt:= TRichEdit.Create(nil);
  RichRpt.Visible:= False;
  RichRpt.Parent:= self;

  AppendToRichEdit(HRE, RichRpt);
  AppendToRichEdit(HRE, RichRpt);

  RichRpt.Lines.SaveToFile(homedir+'Report.rtf');
  RichRpt.Free;
  HRE.FREE;
  REPORTSTRING.Free;
  REPORTSTREAM.Free;

Open in new window


problem with your code is that you append rtf text to rtf text, not rtf formated text to rtf formated text .

Problem with AppendToRichEdit from link I gave - is that this approach add additional line. I will try to work on it... Here are some unsuccessful functions....
0
shawn857Author Commented:
Thanks Sinisa, that looks like just what I need, but I get a compile error on the line declaring the TEditStream "Undeclared Identifier". Maybe this is not available in my Delphi 7?

Thanks
    Shawn
0
shawn857Author Commented:
OK, disregard last message please Sinisa, I had forgot to put RichEdit in my USES clause - that got rid of the compile error. Still though, it's not working right. I imitated your code exactly and it produces a REPORT.RTF file that appears empty when I open it in WordPad. I tried just one AppendToRichEdit(HRE, RichRpt); statement instead of two, and still the REPORT.RTF file appears empty. The file size is 110 bytes however so I renamed it to TXT and viewed it in Notepad. It contained this:

{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fnil System;}}
\viewkind4\uc1\pard\f0\fs20
\par }
 
Looks like all the RTF formatting, but the text 'Here is some text' is not there...

Maybe this just doesn't work on Delphi 7?

Thanks
   Shawn
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Sinisa VukCommented:
I use this in D6. If you put Visible to True:
var
  HRE, RichRpt: TRichEdit;
begin
  HRE:= TRichEdit.Create(nil);
  HRE.Visible:= True;
  HRE.Parent:= self;
  HRE.text := 'Here is some text';

  RichRpt:= TRichEdit.Create(nil);
  RichRpt.Visible:= True;
  RichRpt.Parent:= self;

  AppendToRichEdit(HRE, RichRpt);
  AppendToRichEdit(HRE, RichRpt);

  RichRpt.Lines.SaveToFile('D:\down\Report.rtf');
  RichRpt.Free;
  HRE.FREE;

Open in new window

... then text appears. But there is a blink problem. I've manage this as:
procedure AppendToRichEdit(const source, destination : TRichEdit) ;
 var
   rtfStream: TEditStream;
   sourceStream : TMemoryStream;

   function EditStreamReader(
     dwCookie: DWORD;
     pBuff: Pointer;
     cb: LongInt;
     pcb: PLongInt): DWORD; stdcall;
   begin
     result := $0000;
     try
       pcb^ := TStream(dwCookie).Read(pBuff^, cb) ;
     except
       result := $FFFF;
     end;
   end; (*EditStreamReader*)
 begin
   destination.Lines.BeginUpdate;
   SendMessage(destination.Handle, WM_SETREDRAW, Ord(True), 0);
   sourceStream := TMemoryStream.Create;
   try
     source.Lines.SaveToStream(sourceStream) ;
     sourceStream.Position := 0;
 
     destination.MaxLength := destination.MaxLength + sourceStream.Size;
 
     rtfStream.dwCookie := DWORD(sourceStream) ;
     rtfStream.dwError := $0000;
     rtfStream.pfnCallback := @EditStreamReader;
     destination.Perform(
       EM_STREAMIN,
       SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream)
     ) ;
     if rtfStream.dwError <> $0000 then
       raise Exception.Create('Error appending RTF data.') ;
   finally
     sourceStream.Free;
     destination.Lines.EndUpdate;
     SendMessage(destination.Handle, WM_SETREDRAW, Ord(False), 0);
   end;
 end;

procedure TForm7.Button2Click(Sender: TObject);
var
  HRE, RichRpt: TRichEdit;
  frm: TForm;
begin
  frm := TForm.Create(nil);
  try
    HRE:= TRichEdit.Create(Application);
    try
      HRE.Visible:= False;
      HRE.Parent:= frm;
      SendMessage(HRE.Handle, WM_SETREDRAW, Ord(True), 0);
      HRE.text := 'Here is some text';
      SendMessage(HRE.Handle, WM_SETREDRAW, Ord(False), 0);

      RichRpt:= TRichEdit.Create(Application);
      try
        RichRpt.Visible:= False;
        RichRpt.Parent:= frm;

        AppendToRichEdit(HRE, RichRpt);
        AppendToRichEdit(HRE, RichRpt);
        AppendToRichEdit(HRE, RichRpt);
        AppendToRichEdit(HRE, RichRpt);

        RichRpt.Lines.SaveToFile('D:\down\Report.rtf');
      finally
        RichRpt.Free;
      end;
    finally
      HRE.Free;
    end;
  finally
    frm.Free;
  end;
end;

Open in new window

0
shawn857Author Commented:
Thank you for that Sinisa! That seems to work much better... but I am just wondering about a couple of things (please see attached screenshot, I also tried appending some formatted/colored text):

- Can anything be done about the automatic cr/lf it adds after it appends some text?
- You can see in the screenshot how 'Here is some text' is in a very very small font - smaller than normal. Is it just a matter of setting the font of the HRE RichEdit variable?

Thanks!
   Shawn
richedittofile.JPG
0
shawn857Author Commented:
Hi Sinisa, are you still with me...?

Cheers
    Shawn
0
Sinisa VukCommented:
I'm here....So...modified function AppendToRichEdit:
procedure AppendToRichEdit(const source, destination : TRichEdit) ;
 var
   rtfStream: TEditStream;
   sourceStream: TMemoryStream;
   tmp_stream: TStringStream;
   len: Integer;
 
   function EditStreamReader(
     dwCookie: DWORD;
     pBuff: Pointer;
     cb: LongInt;
     pcb: PLongInt): DWORD; stdcall;
   begin
     result := $0000;
     try
       pcb^ := TStream(dwCookie).Read(pBuff^, cb);
     except
       result := $FFFF;
     end;
   end; 
 begin
   destination.Lines.BeginUpdate;
   sourceStream := TMemoryStream.Create;
   tmp_stream := TStringStream.Create('');
   try
     source.Lines.SaveToStream(tmp_stream);
     //replace ending new line defined as: '/par /par }'
     len := Pos('\par '+#13#10+'\par }', tmp_stream.DataString);
     if len>0 then
     begin
       tmp_stream.Size := len-1;
       tmp_stream.Position := len-1;
       tmp_stream.WriteString('\par }');
     end;
     sourceStream.LoadFromStream(tmp_stream);
     sourceStream.Position := 0;

     rtfStream.dwCookie := DWORD(sourceStream);
     rtfStream.dwError := $0000;
     rtfStream.pfnCallback := @EditStreamReader;
     destination.Perform(
       EM_STREAMIN,
       SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream)
     ) ;
     if rtfStream.dwError <> $0000 then
       raise Exception.Create('Error appending RTF data.') ;
   finally
     sourceStream.Free;
     tmp_stream.Free;
     destination.Lines.EndUpdate;
   end;
 end;

Open in new window

.. to remove ending CRLF

Your small font is because rtf component define font - try to set font before enter text .... and do append after that. I tested with colored text with different font sizes - and it works.
0
shawn857Author Commented:
Thank you Sinisa, but I'm afraid that new updated AppendTpRichEdit does not work for me... once again it produces an "empty" output file. Renaming the file to TXT and viewing in Notepad shows only some formatting, but none of the text string:

{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fnil MS Sans Serif;}}
\viewkind4\uc1\pard\f0\fs16
\par }
 
Thanks
    Shawn
0
Sinisa VukCommented:
Do you have visible RichEdit components? Did you apply
SendMessage(HRE.Handle, WM_SETREDRAW,....);....

Open in new window


lines if RichEdits are hidden?

sorry my finally block should be:
...
   finally
     sourceStream.Free;
     tmp_stream.Free;
     destination.Lines.EndUpdate;
     SendMessage(destination.Handle, WM_SETREDRAW, Ord(False), 0);
   end;

Open in new window

0
shawn857Author Commented:
Thanks Sinisa, that corrected Finally block helped and some output is now being created... but I append 4 lines of text in my test app, yet only 3 lines get output to file - and still, the CR/LF separates the lines. Below is the full code of my small test app Sinisa... I don't see where I am going wrong - I am doing everything that you do:


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Richedit, ComCtrls,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure AppendToRichEdit(const source, destination : TRichEdit) ;
 var
   rtfStream: TEditStream;
   sourceStream: TMemoryStream;
   tmp_stream: TStringStream;
   len: Integer;
 
   function EditStreamReader(
     dwCookie: DWORD;
     pBuff: Pointer;
     cb: LongInt;
     pcb: PLongInt): DWORD; stdcall;
   begin
     result := $0000;
     try
       pcb^ := TStream(dwCookie).Read(pBuff^, cb);
     except
       result := $FFFF;
     end;
   end;
 begin
   destination.Lines.BeginUpdate;
   sourceStream := TMemoryStream.Create;
   tmp_stream := TStringStream.Create('');
   try
     source.Lines.SaveToStream(tmp_stream);
     //replace ending new line defined as: '/par /par }'
     len := Pos('\par '+#13#10+'\par }', tmp_stream.DataString);
     if len>0 then
     begin
       tmp_stream.Size := len-1;
       tmp_stream.Position := len-1;
       tmp_stream.WriteString('\par }');
     end;
     sourceStream.LoadFromStream(tmp_stream);
     sourceStream.Position := 0;

     rtfStream.dwCookie := DWORD(sourceStream);
     rtfStream.dwError := $0000;
     rtfStream.pfnCallback := @EditStreamReader;
     destination.Perform(
       EM_STREAMIN,
       SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream)
     ) ;
     if rtfStream.dwError <> $0000 then
       raise Exception.Create('Error appending RTF data.') ;
   finally
     sourceStream.Free;
     tmp_stream.Free;
     destination.Lines.EndUpdate;
     SendMessage(destination.Handle, WM_SETREDRAW, Ord(False), 0);
   end;
 end;


procedure TForm1.Button1Click(Sender: TObject);
var
  HRE, RichRpt: TRichEdit;
  frm: TForm;
begin
  panel1.caption:='Processing...';

  frm := TForm.Create(nil);
  try
    HRE:= TRichEdit.Create(Application);
    try
      HRE.Visible:= False;
      HRE.Parent:= frm;
      HRE.Font.Name:= 'System';
      HRE.Font.Size:= 10;
      SendMessage(HRE.Handle, WM_SETREDRAW, Ord(True), 0);
      HRE.text := 'Here is some text';
      SendMessage(HRE.Handle, WM_SETREDRAW, Ord(False), 0);

      RichRpt:= TRichEdit.Create(Application);
      try
        RichRpt.Visible:= False;
        RichRpt.Parent:= frm;

        AppendToRichEdit(HRE, RichRpt);
        AppendToRichEdit(HRE, RichRpt);
        AppendToRichEdit(HRE, RichRpt);
        AppendToRichEdit(HRE, RichRpt);

        RichRpt.Lines.SaveToFile('Report.rtf');
      finally
        RichRpt.Free;
      end;
    finally
      HRE.Free;
    end;
  finally
    frm.Free;
  end;
  panel1.caption:='Done';
end;

end.

Open in new window



Thank You!
    Shawn
0
Sinisa VukCommented:
Correct function:
procedure AppendToRichEdit(const source, destination : TRichEdit) ;
 var
   rtfStream: TEditStream;
   sourceStream: TMemoryStream;
   tmp_stream: TStringStream;
   len: Integer;

   function EditStreamReader(
     dwCookie: DWORD;
     pBuff: Pointer;
     cb: LongInt;
     pcb: PLongInt): DWORD; stdcall;
   begin
     result := $0000;
     try
       pcb^ := TStream(dwCookie).Read(pBuff^, cb);
     except
       result := $FFFF;
     end;
   end;
 begin
   destination.Lines.BeginUpdate;
   SendMessage(destination.Handle, WM_SETREDRAW, Ord(True), 0);  //missing before
   sourceStream := TMemoryStream.Create;
   tmp_stream := TStringStream.Create('');
   try
     source.Lines.SaveToStream(tmp_stream);
     //replace ending new line defined as: '/par /par }'
     len := Pos('\par '+#13#10+'\par }', tmp_stream.DataString);
     if len>0 then
     begin
       tmp_stream.Size := len-1;
       tmp_stream.Position := len-1;
       tmp_stream.WriteString('\par }');
     end;
     sourceStream.LoadFromStream(tmp_stream);
     sourceStream.Position := 0;

     rtfStream.dwCookie := DWORD(sourceStream);
     rtfStream.dwError := $0000;
     rtfStream.pfnCallback := @EditStreamReader;
     destination.Perform(
       EM_STREAMIN,
       SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream)
     ) ;
     if rtfStream.dwError <> $0000 then
       raise Exception.Create('Error appending RTF data.') ;
   finally
     sourceStream.Free;
     tmp_stream.Free;
     destination.Lines.EndUpdate;
     SendMessage(destination.Handle, WM_SETREDRAW, Ord(False), 0);
   end;
 end;

Open in new window

...where one line ...WM_SETREDRAW... is missing.
I'm not clear - you want to append text in a one row (line)?
0
Sinisa VukCommented:
if you want it in one line - then replace if block with:
....
    len := Pos(#13#10+'\par }', tmp_stream.DataString);
     if len>0 then
     begin
       tmp_stream.Size := len-1;
       tmp_stream.Position := len-1;
       tmp_stream.WriteString(#13#10+'}');
     end;
...

Open in new window

0
shawn857Author Commented:
Thanks Sinisa, so far n my application that appears to work very well. And yes, I do want everything on one line, and when i want a line break, I just add in a #13#10 to the source string.
  Here is a question though please -with your colution I have no problem appending RichEdit1 to Richedit2 like this:

AppendToRichEdit(RichEdit1, RichEdit2);

That appends the whole of RichEdit1 to the end of RichEdit2. But what about if I only want to append say, the FIRST character (formatting included) in RichEdit1 to RichEdit2? Is that somehow possible?

Thanks!
    Shawn
0
shawn857Author Commented:
hmm, I thought I could be "tricky" and try to save to a stream *only* the character from RichEdit1 that I want... then load that stream into a temporary RichEdit, which i could then use in the AppendToRichEdit call, like this:

ms := TMemoryStream.Create;
ms.Clear;
sRichEdit1.Lines[0][1].SaveToStream(ms);

... but it gave a compile error "Record, Object, or Class type required" on the sRichEdit1.Lines[0][1].SaveToStream(ms)  line. This approach I guess is no good eh?

Shawn
0
Sinisa VukCommented:
ok, I modified source, add procedure GetRtfFormattedSelectedText:
procedure GetRtfFormattedSelectedText(const source: TRichEdit; res_stream: TStringStream);
var
 rtfStream: TEditStream;

 function EditStreamWriter(
   dwCookie: DWORD;
   pBuff: Pointer;
   cb: LongInt;
   pcb: PLongInt): DWORD; stdcall;
 begin
   result := $0000;
   try
     pcb^ := TStream(dwCookie).Write(pBuff^, cb);
   except
     result := $FFFF;
   end;
 end;

begin
  res_stream.Size :=0;

  rtfStream.dwCookie := DWORD(res_stream);
  rtfStream.dwError := $0000;
  rtfStream.pfnCallback := @EditStreamWriter;
  source.Perform(
    EM_STREAMOUT,
    SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream)
    );
  if rtfStream.dwError <> $0000 then
    raise Exception.Create('Error appending RTF data.') ;
end;

procedure AppendToRichEdit(const source, destination : TRichEdit; bSelectionOnly: Boolean) ;
var
 rtfStream: TEditStream;
 sourceStream: TMemoryStream;
 tmp_stream: TStringStream;
 len: Integer;

 function EditStreamReader(
   dwCookie: DWORD;
   pBuff: Pointer;
   cb: LongInt;
   pcb: PLongInt): DWORD; stdcall;
 begin
   result := $0000;
   try
     pcb^ := TStream(dwCookie).Read(pBuff^, cb);
   except
     result := $FFFF;
   end;
 end;
begin
  destination.Lines.BeginUpdate;
  SendMessage(destination.Handle, WM_SETREDRAW, Ord(True), 0);  //missing before
  sourceStream := TMemoryStream.Create;
  tmp_stream := TStringStream.Create('');
  try
    if bSelectionOnly then
      GetRtfFormattedSelectedText(source, tmp_stream)
    else
      source.Lines.SaveToStream(tmp_stream);
       
    //replace ending new line defined as: '/par /par }'
    len := Pos(#13#10+'\par }', tmp_stream.DataString);
    if len>0 then
    begin
      tmp_stream.Size := len-1;
      tmp_stream.Position := len-1;
      tmp_stream.WriteString(#13#10+'}');
    end;

    sourceStream.LoadFromStream(tmp_stream);
    sourceStream.Position := 0;

    rtfStream.dwCookie := DWORD(sourceStream);
    rtfStream.dwError := $0000;
    rtfStream.pfnCallback := @EditStreamReader;
    destination.Perform(
      EM_STREAMIN,
      SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream)
      );
    if rtfStream.dwError <> $0000 then
      raise Exception.Create('Error appending RTF data.') ;
  finally
    sourceStream.Free;
    tmp_stream.Free;
    destination.Lines.EndUpdate;
    SendMessage(destination.Handle, WM_SETREDRAW, Ord(False), 0);
  end;
end;

Open in new window


.... and usage is to set custom selection of that character - similar to:
...
  frm := TForm.Create(nil);
  try
    HRE:= TRichEdit.Create(Application);
    try
      HRE.Visible:= False;
      HRE.Parent:= frm;
      HRE.Font.Name:= 'System';
      HRE.Font.Size:= 10;
      SendMessage(HRE.Handle, WM_SETREDRAW, Ord(True), 0);
      HRE.text := 'Here is some text'+#13#10;
      SendMessage(HRE.Handle, WM_SETREDRAW, Ord(False), 0);
      //make selection - here two first chars
      HRE.SelStart := 0;
      HRE.SelLength := 2;

      RichRpt:= TRichEdit.Create(Application);
      try
        RichRpt.Visible:= False;
        RichRpt.Parent:= frm;

        AppendToRichEdit(HRE, RichRpt, True);
        AppendToRichEdit(HRE, RichRpt, False);
        AppendToRichEdit(HRE, RichRpt, True);
        AppendToRichEdit(HRE, RichRpt, True);
      finally
        RichRpt.Free;
      end;
    finally
      HRE.Free;
    end;
  finally
    frm.Free;
  end;
...

Open in new window


added additional parameter to AppendToRichEdit - can set selection or not.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
shawn857Author Commented:
Brilliant Sinisa! It works wonderfully... thank you so much for your help!

Cheers
    Shawn
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.