Lazarus中文社区

 找回密码
 立即注册(注册审核可向QQ群索取)

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 3736|回复: 0

WINDOWS监控剪贴板字符变化

[复制链接]

该用户从未签到

发表于 2015-12-15 09:45:38 | 显示全部楼层 |阅读模式
将DELPHI下的代码复制到LAZARUS,不能执行,查资料才发现消息要自己写代码。
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  windows,Messages,Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  ComCtrls, StdCtrls, Grids, Buttons, Menus,clipbrd;

type

  { TForm1 }

  TForm1 = class(TForm)
    Bevel1: TBevel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    .....
  
  private
    FNextClipboardOwner: HWnd;   {handle to the next viewer}

    {Here are the clipboard event handlers}
    function WMChangeCBChain(wParam: WParam; lParam: LParam)RESULT;
    function WMDrawClipboard(wParam: WParam; lParam: LParam)RESULT;


    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
var
     PrevWndProc:windows.WNDPROC;

     function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
       lParam: LParam): LRESULT; stdcall;
     begin
       if uMsg=WM_CHANGECBCHAIN then
       begin
         result:=Form1.WMChangeCBChain(wParam,lParam);
         exit;
       end
       else if uMsg=WM_DRAWCLIPBOARD then
       begin
         result:=Form1.WMDrawClipboard(wParam,lParam);
         exit;
       end;
       result:=CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam);

     end;


procedure TForm1.FormCreate(Sender: TObject);
begin

   PrevWndProc:=Windows.WNDPROC(SetWindowLong(Self.Handle,GWL_WNDPROC,PtrInt(@WndCallback)));
   FNextClipboardOwner := SetClipboardViewer(Self.Handle);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    //从观察链中删除本观察窗口
   ChangeClipboardChain(Handle, FNextClipboardOwner);
end;



function TForm1.WMChangeCBChain(wParam: WParam; lParam: LParam): LRESULT;
var
   Remove,Nextt: THandle;
begin
   Remove := WParam;
   Nextt := LParam;
   if FNextClipboardOwner = Remove then
    FNextClipboardOwner := Nextt
   else if FNextClipboardOwner <> 0 then
    SendMessage(FNextClipboardOwner, WM_ChangeCBChain, Remove, Nextt)
end;


function TForm1.WMDrawClipboard(wParam: WParam; lParam: LParam): LRESULT;
var
   s1,s2:string;
   hTopWin,tw2:THandle;
begin
  if Clipboard.HasFormat(CF_TEXT) Then         //  if (Clipboard.HasFormat(CF_TEXT) or Clipboard.HasFormat(CF_OEMTEXT)) then
  Begin
    ShowMessage(Clipboard.AsText);   
  end;
  SendMessage(FNextClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);   {VERY IMPORTANT!}

  Result := 0;
end;




end.
回复

使用道具 举报

*滑块验证:

本版积分规则

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1 )

GMT+8, 2025-5-2 00:43 , Processed in 0.058133 second(s), 9 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表