Tips (1541)

Tip Rating (5):

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 = nil) then
      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 <> nil) then
  begin
    if (EditStreamCallBackData = nil) then
      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;