unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls...;
type
 TForm1 = class(TForm)
  Button1: TButton;
  Button2: TButton;
  function GetClipBoardText: string;
  procedure SetClipBoardText(const Value: string);
  procedure Open;
  procedure SetBuffer(Format: Word; var Buffer; Size: Integer);
  procedure Adding;
  procedure Clear;
  constructor CreateRes(Ident: Integer);
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
 private
  FOpenRefCount: Integer;
  FClipboardWindow: HWND;
  FAllocated: Boolean;
  FEmptied: Boolean;
  FMessage: string;
 public
  { Public declarations }
 end;
var
 Form1: TForm1;
resourcestring
 SCannotOpenClipboard = 'Cannot open clipboard';
implementation

{$R *.dfm}
//Create resource for resourceString
constructor TForm1.CreateRes(Ident: Integer);
begin
 FMessage := LoadStr(Ident);
end;
//Status: Adding
procedure TForm1.Adding;
begin
 if (FOpenRefCount <> 0) and not FEmptied then
 begin
  Clear;
  FEmptied := True;
 end;
end;
//Empty clipboard
procedure TForm1.Clear;
begin
 Open;
 try
  EmptyClipboard;
 finally
  Close;
 end;
end;
//Set buffer
procedure TForm1.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;
//Open the clipboard
procedure TForm1.Open;
begin
 if FOpenRefCount = 0 then
 begin
  FClipboardWindow := Application.Handle;
  if FClipboardWindow = 0 then
  begin
  {$IFDEF MSWINDOWS}
  FClipboardWindow := Classes.AllocateHWnd(MainWndProc);
  {$ENDIF}
  {$IFDEF LINUX}
  FClipboardWindow := WinUtils.AllocateHWnd(MainWndProc);
  {$ENDIF}
  FAllocated := True;
  end;
  if not OpenClipboard(FClipboardWindow) then
  raise Exception.CreateRes(@SCannotOpenClipboard);
  FEmptied := False;
 end;
 Inc(FOpenRefCount);
end;
//Get the clipboard text
function TForm1.GetClipBoardText: string;
var
 Data: THandle;
begin
 Open;
 Data := GetClipboardData(CF_TEXT);
 try
  if Data <> 0 then
  Result := PChar(GlobalLock(Data))
  else
  Result := '';
 finally
  if Data <> 0 then GlobalUnlock(Data);
  Close;
 end;
end;
procedure TForm1.SetClipBoardText(const Value: string);
begin
 //Set ClipboardText
 SetBuffer(CF_TEXT, PChar(Value)^, Length(Value) + 1);
end;
//Get the clipboard text
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetClipboardText);
end;
//Set the clipboard text
procedure TForm1.Button2Click(Sender: TObject);
begin
 SetClipboardText('-> Big-X <-');
end;
end.

procedure CopyStringToClipboard(s: string);
var
 hg: THandle;
 P: PChar;
begin
 hg:=GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, Length(S)+1);
 P:=GlobalLock(hg);
 StrPCopy(P, s);
 GlobalUnlock(hg);
 OpenClipboard(Application.Handle);
 SetClipboardData(CF_TEXT, hg);
 CloseClipboard;
 GlobalFree(hg);
end;