监视剪贴板数据

Posted 2022-09-29 blogpro

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.

View Code

请问gifimage控件有适合delph

问题已经解决，原来d2010对gifimage的写法不一样，写成了 gifimg，在以前的版本里用的是gifimage,然后自然找不到gifimage,再从网上下载gifimage，又因为版本的问题，导致了上面的错误，其实只要在以前用到gifimage的地方，将引用变成gifimg,就可以用d2010自带的gifimage控件了。  不知道 我这种说法是不是对的，如果 有不对，请指正。