[NumLock]

ну не знаю на сколько родной код

Код:

unit Clipbrd;

можно считать извращенным:

Код:

  TClipboard = class(TPersistent)
  private
    procedure SetAsText(const Value: string);
  protected
    procedure SetBuffer(Format: Word; var Buffer; Size: Integer);

procedure TClipboard.SetAsText(const Value: string);
begin
  SetBuffer(CF_TEXT, PChar(Value)^, Length(Value) + 1);
end;

procedure TClipboard.SetBuffer(Format: Word; var Buffer; Size: Integer);
var
  Data: THandle;
  DataPtr: Pointer;
begin
  Open;
  try
    Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Size);
    try
      DataPtr := GlobalLock(Data);
      try
        Move(Buffer, DataPtr^, Size);
        Adding;
        SetClipboardData(Format, Data);
      finally
        GlobalUnlock(Data);
      end;
    except
      GlobalFree(Data);
      raise;
    end;
  finally
    Close;
  end;
end;