Añadir el contenido de un TRichEdit a otro en 64 bits.

[pmarin]

Hola,

este tema ya se trató en un otro tema (ver http://www.clubdelphi.com/foros/showthread.php?t=82322), y lo solucione
con el fabuloso código de Zarko Gajic Append or Insert RTF from one RichEdit to Another

El siguiente codigo funciona perfectamente en 32 bits. El problema aparece cuando lo compilo con 64 bits.
No existen errores de compilacion, pero la ejecución falla. He intentado adaptarlo por mi cuenta pero no
me aclaro con los punteros, LongInt, DWORD, etc.

Como TRichEdit uso los componentes DevExpress VCL, pero esto no es la causa del problema.

Por favor, ¿me podrían ayudar a convertir este codigo a 64 bits?

Saludos
Pablo

Código Delphi [-]
 
unit Unit1;
interface
uses
Windows, Classes, RichEdit, SysUtils, cxRichEdit;
implementation
procedure AppendToRichEdit(const source: TStream;
destination : TcxRichEdit) ;
// ======================================================== //
 
// Name: AppendToRichEdit(source, destination)
 
//
 
{ The TRichEdit control does not expose a method to append or insert a piece of RTF
text. It does have a Lines property to let you add more text - but you'll have
trouble if you want to append rich text formatted content - it will be added
as a (ASCII) simple text.
If you want to "move" the entire text from one rich editor to another you can
use streams - but the content of the "destination" rich editor will be totally
overwritten by the "source" editor's text.
Here's a function that allows appending or inserting RTF text from one Stream
to another - using rich edit specific callback functions.
Note: Include "RichEdit" into the USES section
}
var
rtfStream : TEditStream;
szError : string;
 
{ EditStreamReader callback function }
function EditStreamReaderCallback(
dwCookie: DWORD;
pbBuff: Pointer;
cb: LongInt;
pcb: PLongInt): DWORD; stdcall;
var
theStream: TStream;
dataAvail: LongInt;
begin
theStream := TStream(dwCookie);
with theStream do
begin
dataAvail := Size - Position;
Result := $0000;
if dataAvail <= cb then
begin
try
pcb^ := read(pbBuff^, dataAvail);
if pcb^ <> dataAvail then
Result := UINT(E_FAIL);
except
Result := $FFFF;
end;
end
else
begin
try
pcb^ := read(pbBuff^, cb);
if pcb^ <> cb then
Result := UINT(E_FAIL);
except
Result := $FFFF;
end;
end;
end;
end; (*EditStreamReader*)
begin
destination.Lines.BeginUpdate;
try
source.Position := 0;
rtfStream.dwCookie := DWORD(source) ;
rtfStream.dwError := $0000;
rtfStream.pfnCallback := @EditStreamReaderCallback;
with TcxRichEdit(destination.InnerControl) do
SendMessage(Handle,
EM_STREAMIN,
SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream));
if rtfStream.dwError <> $0000 then
begin
szError := Format('AppendToRichEdit: Error appending RTF data ' +
'with error = %s.', [ IntToStr(rtfStream.dwError) ]);
raise Exception.Create( szError );
end;
finally
destination.Lines.EndUpdate;
end;
(*AppendToRichEdit*)
end;
 
end.

[pmarin]

(Solucionado)

Me contesto a mi mismo. He estado estudiando el problema en profundidad y he
encontrado 2 errores en el codigo anterior. Estos son los dos fallos que habia:

1) En el mundo de 64-bit es necesario crecer los parametros DWORD a DWORD_PTR.
Ya que DWORD_PTR se mapea a DWORD en sistemas 32-bits

2) La funcion CallBack debe estar definida y fuera del procedimiento que la va
a llamar.

Ahora he modificado el codigo y ahora funciona tanto en 32 bits como en 64 bits.

Código Delphi [-]
{ EditStreamReader callback function }
function EditStreamReader( dwCookie: DWORD_PTR; pbBuff: PByte;
     cb: LongInt; var pcb: Longint): LongInt; stdcall;
begin
     result := $0000;
     try
       pcb := TStream(dwCookie).Read(pbBuff^, cb) ;
     except
       result := $FFFF;
     end;
(*EditStreamReader*)
end;

procedure AppendToRichEdit(const source, destination : TRichEdit) ;
var
   rtfStream: TEditStream;
   sourceStream : TMemoryStream;

begin
   destination.Lines.BeginUpdate;
   sourceStream := TMemoryStream.Create;
   try
     source.Lines.SaveToStream(sourceStream) ;
     sourceStream.Position := 0;

     destination.MaxLength := destination.MaxLength + sourceStream.Size;

     rtfStream.dwCookie := DWORD_PTR(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;
   end;

(*AppendToRichEdit*)
end;

[pmarin]

(Otra Solucion)

Para los RichEdit de DevExpress la solucion anterior funciona simplemente cambiando lo siguiente:

Código Delphi [-]
 
with TcxRichEdit(destination.InnerControl) do
SendMessage(Handle,
EM_STREAMIN,
SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@rtfStream));

Pero aqui les dejo otra solucion para estos mismos componentes. Es una forma mas lenta. La causa
de ello es que hay que seleccionar todo el texto del RichEdit de destino cada vez que se hace una
adicion. Pero si se hacen pocos adiciones, o el RichEdit de destino es pequeño puede valer la pena
olvidarse de los CallBacks.

Código Delphi [-]
 
procedure TSQLBuilder32.AppendToRichEdit(const source: TStream;
    destination : TcxRichEdit) ;
// ======================================================== //
// Name: AppendToRichEdit(source, destination)
//
var
   rtfStream  : TEditStream;
   ASelStart, ASelLength: Integer;
begin
   destination.Lines.BeginUpdate;
  with destination do
  begin
    ASelStart := SelStart;
    ASelLength := SelLength;
    try
      Properties.StreamModes := Properties.StreamModes + [resmSelection];
      try
        SelStart := ASelStart;
        SelLength := ASelLength;
        Lines.LoadFromStream(source);
        ModifiedAfterEnter := True;
      finally
        Properties.StreamModes := Properties.StreamModes - [resmSelection];
      end;
    finally
      destination.Lines.EndUpdate;
    end;
  end;
(*AppendToRichEdit*)
end;

[santiago14]

Empezado por pmarin

Hola,

este tema ya se trató en un otro tema (ver http://www.clubdelphi.com/foros/showthread.php?t=82322), y lo solucione
con el fabuloso código de Zarko Gajic Append or Insert RTF from one RichEdit to Another

Buenas. Hace días que intento ver el Artículo de Zarko Gajic, lamentablemente no está disponible ya. La página ha desaparecido.
¿Alguien tiene el código por ahí para que me lo pase?
Necesito juntar dos RichEdit's en uno solo, conservando el formato y parece que la solución está en ese código.
Espero haber sido claro.
Gracias.
Buenos días.

Santiago.

[Casimiro Notevi]

Mira aquí.