Recent

Author Topic: CopyToClipboard  (Read 6111 times)

rick2691

  • Sr. Member
  • ****
  • Posts: 410
Re: CopyToClipboard
« Reply #15 on: October 14, 2021, 04:28:34 pm »
I have been trying to get rid of the erratic italics problem, but with no success.

So I looked in RichMemoUtils for the CopyRichText functions ...

I have questions about the following:

_CopyDirect ... variables: ofs, ln, fnt  ...do not appear to be initialized.

I see that GetTextAttributes conditionally sets ofs & ln, but I haven't noticed anything for when they are outside the condition.

I also don't see how InitFontParams is assigning anything to variable fnt, and it doesn't appear to be initialized before going to the function.

Rick
Windows 10, LAZ 2.0.12, FPC 3.2.0, SVN 64642, i386-win32-win32/win64, using windows unit

rick2691

  • Sr. Member
  • ****
  • Posts: 410
Re: CopyToClipboard
« Reply #16 on: December 23, 2021, 04:40:49 pm »
I have tried every option to make CopyRichText work for my needs. With no more response from anyone I started researching things on my own.

I found the following code on a forum. I think it was for RichEdit and Delphi, so I tweaked it.

It has two methods: GetRTFselection and PutRTFselection.

I also found some code on this forum by "typo". He used TMemoryStream, and that made everything work. Before finding that, it was not working on account of using TStringStream.

I have been testing it all, and have not found any failures yet.

Rick

Code: Pascal  [Select][+][-]
  1. //======================== begin: stream callback for Get/PutRTFselection
  2. // (this code section must precede any use of Get/PutRTFselection)
  3.  
  4. // by Peter Below (TeamB)  < 100113.1...@compuserve.com >
  5.  
  6. // Stream Callback function
  7. type
  8.   TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
  9.                                  cb: Longint; var pcb: Longint
  10.                                 ): DWORD; stdcall;
  11.   TEditStream = record
  12.                 dwCookie: Longint;
  13.                 dwError: Longint;
  14.                 pfnCallback: TEditStreamCallBack;
  15.                 end;
  16.  
  17. // EditStreamOutCallback callback function
  18. function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte;
  19.                                cb: Longint; var pcb: Longint
  20.                               ): DWORD; stdcall;
  21. var theStream: TStream;
  22. begin
  23.   theStream:= TStream(dwCookie);
  24.   with theStream do
  25.        begin
  26.        If cb > 0 Then
  27.           begin
  28.           pcb:= Write(pbBuff^, cb);
  29.           Result:= pcb;
  30.           end else Result:= 0;
  31.        end;
  32. end;
  33.  
  34. // EditStreamInCallback callback function
  35. function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  36.                               cb: Longint; var pcb: Longint
  37.                              ): DWORD; stdcall;
  38. var
  39.   theStream: TStream;
  40.   dataAvail: LongInt;
  41. begin
  42.   theStream:= TStream(dwCookie);
  43.   with theStream do // open theStream attributes for access; ie. theStream.size
  44.        begin
  45.          dataAvail:= Size - Position; // size & position are attributes of "theStream"; ie. theStream.size
  46.          Result:= 0;
  47.          if dataAvail<=cb then
  48.             begin
  49.               pcb:= read(pbBuff^, dataAvail);
  50.               if pcb<>dataAvail then Result:= UINT(E_FAIL);
  51.             end
  52.             else
  53.             begin
  54.               pcb:= read(pbBuff^, cb);
  55.               if pcb<>cb then Result:= UINT(E_FAIL);
  56.             end;
  57.        end;
  58. end;
  59.  
  60. // copyout Stream from RichEdit: uses stream callback above
  61. Procedure GetRTFSelection(Amemo: TRichMemo; IntoStream: TStream);
  62. Var editstream: TEditStream;
  63. Begin
  64.   with editstream Do
  65.        Begin
  66.        dwCookie:= Longint(IntoStream);
  67.        dwError:= 0;
  68.        pfnCallback:= @EditStreamOutCallBack;
  69.        end;
  70.   Amemo.Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@EditStream));
  71. End;
  72.  
  73. // Insert Stream into RichEdit: uses stream callback above
  74. procedure PutRTFSelection(Amemo: TRichMemo; SourceStream: TStream);
  75. var EditStream: TEditStream;
  76. begin
  77.   with EditStream do
  78.        begin
  79.        dwCookie:= Longint(SourceStream);
  80.        dwError:= 0;
  81.        pfnCallback:= @EditStreamInCallBack;
  82.        end;
  83.   Amemo.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
  84. end;
  85.  
  86. //=================================== end: stream callback for Get/PutRTFselection
  87.  
  88.  
  89.  
  90. //=========== begin: my application of the functions
  91.  
  92. procedure TCmdForm.CopyPageMemo;  // PageMemo to SearchBox & ReplaceBox
  93. var MS: TMemoryStream; { TMemoryStream use by typo;
  94.                          https://forum.lazarus.freepascal.org/index.php?topic=26425.45 }
  95. begin
  96.   SearchBox.Clear;
  97.   // PageMemo section already selected
  98.   MS:= TMemoryStream.Create;  { TMemoryStream use by Author: typo }
  99.   try
  100.     GetRTFSelection(PageMemo,MS);  // PageMemo is an RTF container
  101.     MS.Position:= 0;          { TMemoryStream use by Author: typo }
  102.     PutRTFSelection(SearchBox,MS);  // SearchBox is an RTF container
  103.   finally
  104.     MS.Free;
  105.     PageMemo.SelLength:= 0;
  106.   end;
  107. end;
  108.  
  109. //=========== end: my application of the functions  
  110.  
« Last Edit: December 23, 2021, 04:56:51 pm by rick2691 »
Windows 10, LAZ 2.0.12, FPC 3.2.0, SVN 64642, i386-win32-win32/win64, using windows unit

rick2691

  • Sr. Member
  • ****
  • Posts: 410
Re: CopyToClipboard
« Reply #17 on: March 03, 2022, 02:23:55 pm »
I just discovered that the previous codes for GetRTFselection and PutRTFselection have a disfunction when you have an image seleted or the selection is otherwise too long.

I have also found that others have had similar problems ... and they have posted the following:

Code: Pascal  [Select][+][-]
  1. //=================================== begin: stream callback for Get/PutRTFselection
  2.  
  3. // by Peter Below (TeamB)  < 100113.1...@compuserve.com >
  4.  
  5. // Stream Callback function
  6. type
  7.   TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
  8.                                  cb: Longint; var pcb: Longint
  9.                                 ): DWORD; stdcall;  //  DWORD was Longint
  10.   TEditStream = record
  11.                 dwCookie: Longint;
  12.                 dwError: Longint;
  13.                 pfnCallback: TEditStreamCallBack;
  14.                 end;  
  15.  
  16. // Callback function for EM_STREAMOUT ... by the TEAM (who are co-workers with Peter Below)
  17. //
  18. function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte;
  19.                                cb: Longint; var pcb: Longint): DWORD; stdcall;
  20. begin                          //  DWORD was Longint
  21.   // This will write the contents of the RichEdit to a TMemoryStream field.
  22.   //
  23.   // dwCookie is Application-defined, so we're passing the blob stream.
  24.   //
  25.   pcb:= TMemoryStream(dwCookie).Write(pbBuff^, cb);
  26.   Result:= 0;
  27. end;
  28.  
  29. // Callback function for EM_STREAMIN
  30. //
  31. function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  32.                               cb: Longint; var pcb: Longint): DWORD; stdcall;
  33. var                           //  DWORD was Longint
  34.   theStream: TMemoryStream;  // use TMemoryStream instead of TStream.
  35. begin
  36.   // This will write the contents of a TMemoryStream field to a RichEdit.
  37.   //
  38.   // dwCookie is Application-defined, so we're passing the stream containing
  39.   // the formatted text to be added.
  40.   //
  41.   theStream:= TMemoryStream(dwCookie);
  42.   Result:= 0;
  43.  
  44.   with theStream do
  45.        begin
  46.        if (Size - Position) <= cb then
  47.            begin
  48.            pcb:= Size;
  49.            Read(pbBuff^, Size);
  50.            end
  51.            else begin
  52.                 pcb:= cb;
  53.                 Read(pbBuff^, cb);
  54.                 end;
  55.        end;
  56. end;
  57.  
  58. // copyout Stream from RichEdit: uses stream callback above
  59. Procedure GetRTFSelection(Amemo: TRichMemo; IntoStream: TMemoryStream);  // TStream);
  60. Var EditStream: TEditStream;
  61. Begin
  62.   with EditStream Do
  63.        Begin
  64.        dwCookie:= Longint(IntoStream);
  65.        dwError:= 0;
  66.        pfnCallback:= @EditStreamOutCallBack;
  67.        end;
  68.   Amemo.Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@EditStream));
  69. End;
  70.  
  71. // Insert Stream into RichEdit: uses stream callback above
  72. procedure PutRTFSelection(Amemo: TRichMemo; SourceStream: TMemoryStream);  // TStream);
  73. var EditStream: TEditStream;
  74. begin
  75.   with EditStream do
  76.        begin
  77.        dwCookie:= Longint(SourceStream);
  78.        dwError:= 0;
  79.        pfnCallback:= @EditStreamInCallBack;
  80.        end;
  81.   Amemo.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@EditStream));
  82. end;
  83.  

The above replacement codes work perfectly. I have been able to copy a 100 page RTF document to another RTF container that also had unicode fonts and a dozen JPG images.
« Last Edit: March 03, 2022, 02:34:30 pm by rick2691 »
Windows 10, LAZ 2.0.12, FPC 3.2.0, SVN 64642, i386-win32-win32/win64, using windows unit

Thaddy

  • Hero Member
  • *****
  • Posts: 11528
Re: CopyToClipboard
« Reply #18 on: March 03, 2022, 02:31:55 pm »
As long as RTF is registered as a clipboard format (default in Windows) you should not have those issues. As you already discovered, a stringsteam is NOT suitable for RTF, because an RTF can contain binary data. (that is programmer error)
A memorystream or filestream will work.
« Last Edit: March 03, 2022, 02:36:58 pm by Thaddy »
Путин преступник. Россияне дезинформированы.

rick2691

  • Sr. Member
  • ****
  • Posts: 410
Re: CopyToClipboard
« Reply #19 on: March 03, 2022, 02:39:25 pm »
Thaddy,

Please note that I added some codes to what I just posted while you were responding.

OK, you lost me on registering. How is that done?

However, the above codes are functioning without that apparent registration. Unless I have forgotten that I did it at some point long ago.

Rick
Windows 10, LAZ 2.0.12, FPC 3.2.0, SVN 64642, i386-win32-win32/win64, using windows unit

rick2691

  • Sr. Member
  • ****
  • Posts: 410
Re: CopyToClipboard
« Reply #20 on: March 03, 2022, 02:48:30 pm »
Thaddy,

My browser was going crazy, so I had missed your comment about TStringStream. Changing to TMemoryStream had not fixed the problem. But I have left it in because it is safer than TStringStream.

What was bad was the code for EditStreamInCallback and EditStreamOutCallback.

Rick
Windows 10, LAZ 2.0.12, FPC 3.2.0, SVN 64642, i386-win32-win32/win64, using windows unit

rick2691

  • Sr. Member
  • ****
  • Posts: 410
Re: CopyToClipboard
« Reply #21 on: March 11, 2022, 12:46:02 pm »
This thread was carried further with
https://forum.lazarus.freepascal.org/index.php?topic=58536.0
With which it was resolved.

Rick
Windows 10, LAZ 2.0.12, FPC 3.2.0, SVN 64642, i386-win32-win32/win64, using windows unit

 

TinyPortal © 2005-2018