...copy formated Rtf-Text from one TRichedit to an other?

Author: NicoDE

Category: VCL

uses
  
RichEdit;

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

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


const
  
EditStreamCookieDoOut = 0;
  EditStreamCookieDoIn = 1;

var
  
EditStreamCallBackData: PChar;
  EditStreamCallBackPos: Longint;

function EditStreamCallBack(dwCookie: Longint; pbBuff: PByte; cb: Longint;
  var pcb: Longint): DWORD; stdcall;
var
  
Size: Integer;
  Data: PChar;
begin
  case 
dwCookie of
    
EditStreamCookieDoOut:
      begin
        if 
EditStreamCallBackData = nil then
        begin
          
Data := GetMemory(cb);
          if Data <> nil then
            try
              
CopyMemory(Data, pbBuff, cb);
              EditStreamCallBackData := Data;
              EditStreamCallBackPos := cb;
              pcb := cb;
              Result := ERROR_SUCCESS;
            except
              
Result := ERROR_CANNOT_COPY;
            end
          else
          begin
            
Result := ERROR_NOT_ENOUGH_MEMORY;
          end;
        end
        else
        begin
          
Data := GetMemory(EditStreamCallBackPos + cb);
          if Data <> nil then
            try
              
CopyMemory(Data, EditStreamCallBackData, EditStreamCallBackPos);
              CopyMemory(@Data[EditStreamCallBackPos], pbBuff, cb);
              FreeMemory(EditStreamCallBackData);
              EditStreamCallBackData := Data;
              EditStreamCallBackPos := EditStreamCallBackPos + cb;
              pcb    := cb;
              Result := ERROR_SUCCESS;
            except
              
Result := ERROR_CANNOT_COPY;
            end
          else
          begin
            
Result := ERROR_NOT_ENOUGH_MEMORY;
          end;
        end;
      end;
    EditStreamCookieDoIn:
      begin
        if 
EditStreamCallBackData <> nil then
        begin
          
Size := lstrlen(EditStreamCallBackData) + 1 - EditStreamCallBackPos;
          if Size > 0 then
          begin
            if 
cb < Size then
              
pcb := cb
            else
              
pcb := Size;
            try
              
CopyMemory(pbBuff, @EditStreamCallBackData[EditStreamCallBackPos], pcb);
              EditStreamCallBackPos := EditStreamCallBackPos + pcb;
              Result := ERROR_SUCCESS;
            except
              
Result := ERROR_CANNOT_COPY;
            end;
          end
          else
          begin
            
Result := ERROR_INSUFFICIENT_BUFFER;
          end;
        end
        else
        begin
          
Result := ERROR_NO_DATA;
        end;
      end;
    else
      
Result := ERROR_INVALID_PARAMETER;
  end;
end;

{------------------------------------------------------------------------------}

function StreamOutRtf(const RichEdit: HWND; out Stream: PChar): Cardinal;
var
  
EditStream: TEditStream;
begin
  if 
(RichEdit <> 0) and IsWindow(RichEdit) then
  begin
    if 
(EditStreamCallBackData = nilthen
      try
        
EditStream.dwCookie := EditStreamCookieDoOut;
        EditStream.dwError := ERROR_NO_DATA;
        EditStream.pfnCallback := EditStreamCallBack;
        SendMessage(RichEdit, EM_STREAMOUT, SF_RTF, lParam(@EditStream));
        Result := EditStream.dwError;
        RaiseLastWin32Error;
        if Result <> ERROR_SUCCESS then
        begin
          if 
EditStreamCallBackData <> nil then
            
FreeMemory(EditStreamCallBackData);
        end
        else
        begin
          
Stream := GetMemory(EditStreamCallBackPos + 1);
          if Stream <> nil then
            try
              
ZeroMemory(Stream, EditStreamCallBackPos + 1);
              CopyMemory(Stream, EditStreamCallBackData, EditStreamCallBackPos);
            except
              
FreeMemory(Stream);
              Stream := nil;
              Result := ERROR_CANNOT_COPY;
            end
          else
          begin
            
Result := ERROR_NOT_ENOUGH_MEMORY;
          end;
          if Result <> ERROR_SUCCESS then
            
FreeMemory(EditStreamCallBackData);
        end;
      finally
        
EditStreamCallBackData := nil;
        EditStreamCallBackPos  := 0;
      end
    else
    begin
      
Result := ERROR_NOT_READY;
    end;
  end
  else
  begin
    
Result := ERROR_INVALID_PARAMETER;
  end;
end;

function StreamInRtf(const RichEdit: HWND; const Stream: PChar): Cardinal;
var
  
EditStream: TEditStream;
begin
  if 
(RichEdit <> 0) and IsWindow(RichEdit) and (Stream <> nilthen
  begin
    if 
(EditStreamCallBackData = nilthen
      try
        
EditStreamCallBackData := Stream;
        EditStreamCallBackPos := 0;
        EditStream.dwCookie := EditStreamCookieDoIn;
        EditStream.dwError := ERROR_NO_DATA;
        EditStream.pfnCallback := EditStreamCallBack;
        SendMessage(RichEdit, EM_STREAMIN, SF_RTF, lParam(@EditStream));
        Result := EditStream.dwError;
      finally
        
EditStreamCallBackData := nil;
        EditStreamCallBackPos  := 0;
      end
    else
    begin
      
Result := ERROR_NOT_READY;
    end;
  end
  else
  begin
    
Result := ERROR_INVALID_PARAMETER;
  end;
end;

{----------------------------------------------------------}

// Example:

procedure TForm1.Button1Click(Sender: TObject);
var
  
Data: PChar;
  P: TPoint;
begin
  if 
StreamOutRtf(RichEdit1.Handle, Data) = ERROR_SUCCESS then
    try
      if 
StreamInRtf(RichEdit2.Handle, Data) = ERROR_SUCCESS then
      begin
        
MessageBox(0, 'RTF Stream copied/ RTF-Stream kopiert.', 'ok', MB_ICONINFORMATION);
      end
      else
      begin
        
MessageBox(0, 'Error while Reading the Target Source'+
                      '/Fehler beim Schreiben des Ziels!', nil, 0);
      end;
    finally
      
FreeMemory(Data);
    end
  else
  begin
    
MessageBox(0, 'Error while writing to Source'+
                  '/Fehler beim Einlesen der Quelle!', nil, 0);
  end;
end;

 

printed from
www.swissdelphicenter.ch
developers knowledge base