TClipBoard剪贴板观察器响应系统消息

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Clipbrd, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    SaveDialog1: TSaveDialog;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
    MyBitmap: TBitmap; //保存截获的位图
    View: Boolean; //判断是否显示
    NextViewerHandle: HWND; //下一剪贴板观察器的句柄
    procedure WMDrawClipBoard(var Msg: TWMDrawClipBoard);
    message WM_DRAWCLIPBOARD;
    procedure WMChangeCBChain(var Msg: TWMChangeCBChain);
    message WM_CHANGECBCHAIN; //响应Windows的剪贴板消息
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  View := False; //不显示剪贴板中的图像
  SpeedButton2.Down := True;
  MyBitmap := TBitmap.Create; //创建MyBitmap对象
  Try
    MyBitmap.Width := 0;
    MyBitmap.Height := 0;
  Except
    Application.Terminate;
  end;
  ClipBoard.Clear; //删除剪贴板中的内容
  NextViewerHandle := SetClipBoardViewer(Handle);  //Windows API 用于登陆剪贴板观察器链
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ChangeClipBoardChain(Handle,NextViewerHandle); //Windows API 用于退出剪贴板观察器链
  MyBitmap.Free; //释放内存
end;

//在剪贴板观察器链上其他观察器退出里被调用，
//根据被移出观察器的不同位置决定了不能的处理方法
procedure TForm1.WMChangeCBChain(var Msg: TWMChangeCBChain);
begin
  if Msg.Remove = NextViewerHandle then
    NextViewerHandle := Msg.Next
  else
    if NextViewerHandle <> 0 then
      SendMessage(NextViewerHandle,Msg.Msg,Msg.Remove,Msg.Next);
  Msg.Result := 0;     
end;

//保存位图：在剪贴板内容变化时被调用
procedure TForm1.WMDrawClipBoard(var Msg: TWMDrawClipBoard);
var
  FileName: String;
begin
  if NextViewerHandle <> 0 then //剪贴板观察器链中是否还存在下一个观察器
    SendMessage(NextViewerHandle,msg.Msg,0,0);
  if ClipBoard.HasFormat(CF_BITMAP) then //格式是否为位图
  begin
    MyBitmap.Assign(ClipBoard); //拷贝位图
    if SaveDialog1.Execute then //保存位图
    begin
      FileName := SaveDialog1.FileName;
      MyBitmap.SaveToFile(FileName);
    end;
    if View then  //显示图像
    begin
      WindowState := wsNormal; //窗口恢复大小
      Image1.Picture.Bitmap := MyBitmap;
    end;
  end;
  Msg.Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WindowState := wsMinimized;   //最小化窗口
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  View := True;
  Image1.Picture.Bitmap := MyBitmap; //显示图像
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  View := false;
  Image1.Picture.Bitmap := nil; //不显示图像
end;

end.