2008. április 25., péntek

How to copy one TRichEdit to another


Problem/Question/Abstract:

How to copy one TRichEdit to another

Answer:

type
  TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
    cb: Longint; var pcb: Longint): DWORD; stdcall;

  TEditStream = record
    dwCookie: Longint;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end;

function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): DWORD; stdcall;
var
  theStream: TStream;
  dataAvail: LongInt;
begin
  theStream := TStream(dwCookie);
  with theStream do
  begin
    dataAvail := Size - Position;
    Result := 0; {assume everything is ok}
    if dataAvail <= cb then
    begin
      pcb := Read(pbBuff^, dataAvail);
      if pcb <> dataAvail then {couldn't read req. amount of bytes}
        result := E_FAIL;
    end
    else
    begin
      pcb := Read(pbBuff^, cb);
      if pcb <> cb then
        result := E_FAIL;
    end;
  end;
end;

function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb:
  Longint; var pcb: Longint): DWORD; stdcall;
var
  theStream: TStream;
begin
  theStream := TStream(dwCookie);
  with theStream do
  begin
    if cb > 0 then
      pcb := Write(pbBuff^, cb);
    Result := 0;
  end;
end;

procedure GetRTFSelection(aRichEdit: TRichEdit; intoStream: TStream);
var
  editstream: TEditStream;
begin
  with editstream do
  begin
    dwCookie := Longint(intoStream);
    dwError := 0;
    pfnCallback := EditStreamOutCallBack;
  end;
  aRichedit.Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@editstream));
end;

procedure PutRTFSelection(aRichEdit: TRichEdit; sourceStream: TStream);
var
  editstream: TEditStream;
begin
  with editstream do
  begin
    dwCookie := Longint(sourceStream);
    dwError := 0;
    pfnCallback := EditStreamInCallBack;
  end;
  aRichedit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@editstream));
end;

procedure InsertRTF(aRichEdit: TRichEdit; s: string);
var
  aMemStream: TMemoryStream;
begin
  if Length(s) > 0 then
  begin
    aMemStream := TMemoryStream.Create;
    try
      aMemStream.Write(s[1], length(s));
      aMemStream.Position := 0;
      PutRTFSelection(aRichEdit, aMemStream);
    finally
      aMemStream.Free;
    end;
  end;
end;

procedure CopyRTF(aSource, aDest: TRichEdit);
var
  aMemStream: TMemoryStream;
begin
  aMemStream := TMemoryStream.Create;
  try
    GetRTFSelection(aSource, aMemStream);
    aMemStream.Position := 0;
    PutRTFSelection(aDest, aMemStream);
  finally
    aMemStream.Free;
  end;
end;

Nincsenek megjegyzések:

Megjegyzés küldése