监视剪贴板数据

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, clipbrd, StdCtrls, ComCtrls, Menus, ExtCtrls, ToolWin;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    ToolBar1: TToolBar;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    N1: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    TabSheet7: TTabSheet;
    TabSheet8: TTabSheet;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    ListView1: TListView;
    Button3: TButton;
    Image1: TImage;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }


  public
    { Public declarations }
    next: HWND;
    // 定义一个消息过程用于处理wm_drawclipboard消息
    // procedure WMdrawclipboard(var aa: TMessage);message wm_drawclipboard;
     MyBitmap: TBitmap; { 保存截获的位图 }
    View: Boolean; { 判断是否显示 }
    NextViewerHandle: HWND; { 下一剪贴板观察器的句柄 }
    procedure WMDrawClipboard(var Msg: TWMDrawClipboard);
    message WM_DRAWCLIPBOARD;
    procedure WMChangeCBChain(var Msg: TWMChangeCBChain);
    message WM_CHANGECBCHAIN;
  end;

var
  Form1: TForm1;

  { 响应Windows的剪贴板消息 }
implementation

uses PCHardWareInfo;
{$R *.dfm}
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
  next := SetClipboarDviewer(handle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ChangeClipboardChain(handle, next);
  SendMessage(next, WM_CHANGECBCHAIN, handle, next);
  MyBitmap.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  // PCHardWareInfo.TPCUserInfo.GetHostIP;
  View := False;
  // SpeedButton2.Down := True;
  MyBitmap := TBitmap.create;
  try
    MyBitmap.Width := 0;
    MyBitmap.Height := 0;
  except
    Application.terminate;
  end;
  ClipBoard.Clear;
  NextViewerHandle := SetClipboarDviewer(handle);
end;

// procedure TForm1.wmdrawclipboard(var aa: tmessage);
// begin
// SendMessage(next,aa.Msg ,aa.WParam ,aa.LParam );
// if(clipboard.hasformat(CF_TEXT)or clipboard.HasFormat(CF_OEMTEXT) )then
// begin
// memo1.Clear;
// memo1.Lines.Add(clipboard.AsText);
// end;
// end;
end.