type 
  CTest = record 
    s: string[255]; 
    i: integer; 
    d: double; 
  end; 
 
var 
  MyFormat: Cardinal; 
  P_CTest: ^CTest; 
 
const 
  CFormat = 'CF_MyFormat'; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  GetMem(P_CTest, sizeof(CTest)); 
  MyFormat := RegisterClipBoardformat(pchar(CFormat)); 
  if MyFormat = 0 then showmessage('Format konnte nicht registriert werden'); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FreeMem(P_CTest); 
end; 
 
function InsBoard(h: THandle; p: Pointer; fmt: Cardinal): THandle; 
begin 
  OpenClipBoard(h); 
  EmptyClipBoard; 
  result := SetClipBoardData(fmt, THandle(p)); 
  CloseClipBoard; 
end; 
 
function AusBoard(h: THandle; p: Pointer; fmt, grss: Cardinal): boolean; 
var 
  ch: THandle; 
  cp: Pointer; 
begin 
  result := false; 
  OpenClipBoard(h); 
  if IsClipBoardFormatAvailable(fmt) 
    then begin 
    ch := GetClipBoardData(fmt); 
    cp := GlobalLock(ch); 
    CopyMemory(p, cp, grss); 
    GlobalUnlock(ch); 
    result := true; 
  end; 
  CloseClipBoard; 
end; 
 
 
// Daten in die Zwischenablage stellen 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  P_CTest^.s := 'Das ist ein Test'; 
  P_CTest^.i := 100; 
  P_CTest^.d := 123.456; 
  if InsBoard(handle, P_CTest, MyFormat) = 0 then showmessage('Fehler'); 
end; 
 
// Daten aus der Zwischenablage holen 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  // zur Kontrolle leeren 
  zeromemory(P_CTest, sizeof(CTest)); 
  Label1.caption := ''; 
  Label2.caption := ''; 
  Label3.caption := ''; 
 
  if not AusBoard(handle, P_CTest, MyFormat, sizeof(CTest)) then 
    showmessage('Fehler') 
  else begin 
    Label1.caption := P_CTest^.s; 
    Label2.caption := inttostr(P_CTest^.i); 
    Label3.caption := floattostr(P_CTest^.d); 
  end; 
end;