unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Label1: TLabel; 
    procedure FormCreate(Sender: TObject); 
  private 
    NextClip: HWND; 
    procedure CCBC(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN; 
    procedure DrawC(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD; 
  public 
    procedure ausfuehren(b: boolean); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var CF: UInt; 
 
procedure TForm1.CCBC(var Msg: TWMChangeCBChain); 
begin 
  inherited; 
  Msg.Result := 0; 
  if Msg.Remove = NextClip then NextClip := Msg.Next else 
    SendMessage(NextClip, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next); 
end; 
 
procedure TForm1.DrawC(var Msg: TWMDrawClipboard); 
begin 
  inherited; 
  SendMessage(NextClip, WM_DRAWCLIPBOARD, 0, 0); 
  ausfuehren(IsClipboardFormatAvailable(CF)); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  CF := CF_Bitmap; 
  NextClip := SetClipboardViewer(Handle); 
end; 
 
procedure TForm1.ausfuehren(b: boolean); 
begin 
  if b then 
    label1.caption := 'In der Zwischenablage steht ein Bitmap zur Verfügung' 
  else label1.caption := ''; 
end; 
 
end.

//------------------------------------------------------------------

type 
  TForm1 = class(TForm) 
    Label1: TLabel; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure ClipBoardChanged(var Message: TMessage); message WM_DRAWCLIPBOARD; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var 
  H: THandle; 
 
procedure TForm1.ClipBoardChanged(var Message: TMessage); 
begin 
  if IsClipboardFormatAvailable(CF_TEXT) then 
    label1.caption := 'In der Zwischenablage steht Text zur Verfügung' 
  else label1.caption := ''; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  label1.caption := ''; 
  H := SetClipboardViewer(Handle); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  ChangeClipboardChain(Handle, H); 
end;