Trap mouse events outside of my application-阿里云开发者社区

Trap mouse events outside of my application

2017-11-16 952

版权

本文内容由阿里云实名注册用户自发贡献，版权归原作者所有，阿里云开发者社区不拥有其著作权，亦不承担相应法律责任。具体规则请查看《阿里云开发者社区用户服务协议》和《阿里云开发者社区知识产权保护指引》。如果您发现本社区中有涉嫌抄袭的内容，填写侵权投诉表单进行举报，一经查实，本社区将立刻删除涉嫌侵权内容。

简介：

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, StdCtrls;
type
  TForm1 = class (TForm)
    ApplicationEvents1: TApplicationEvents;
    Button_StartJour: TButton;
    Button_StopJour: TButton;
    ListBox1: TListBox;

procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);

procedure Button_StartJourClick(Sender: TObject);

procedure Button_StopJourClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);
   private
    { Private declarations }
    FHookStarted : Boolean;
   public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R * .dfm}
var
  JHook: THandle;

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
var
  Char1: PChar;
  s: string ;
begin
  { this is the JournalRecordProc}
  Result : = CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
  {the CallNextHookEX is not really needed for journal hook since it it not
  really in a hook chain, but it ' s standard for a Hook}
   if Code < 0 then Exit;
  {you should cancel operation if you get HC_SYSMODALON}
   if Code = HC_SYSMODALON then Exit;
   if Code = HC_ACTION then
  begin
    {
    The lParam parameter contains a pointer to a TEventMsg
    structure containing information on
    the message removed from the system message queue.
    }
    s : = '' ;
     if EventStrut.message = WM_LBUTTONUP then
      s : = ' Left Mouse UP at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);
     if EventStrut.message = WM_LBUTTONDOWN then
      s : = ' Left Mouse Down at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);
     if EventStrut.message = WM_RBUTTONDOWN then
      s : = ' Right Mouse Down at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);
     if (EventStrut.message = WM_RBUTTONUP) then
      s : = ' Right Mouse Up at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);
     if (EventStrut.message = WM_MOUSEWHEEL) then
      s : = ' Mouse Wheel at X pos ' +
        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);
     if (EventStrut.message = WM_MOUSEMOVE) then
      s : = ' Mouse Position at X: ' +
        IntToStr(EventStrut.paramL) + ' and Y: ' + IntToStr(EventStrut.paramH);
     if s <> '' then
       Form1.ListBox1.ItemIndex : =   Form1.ListBox1.Items.Add(s);
  end;
end;

procedure TForm1.Button_StartJourClick(Sender: TObject);
begin
   if FHookStarted then
  begin
    ShowMessage( ' Mouse is already being Journaled, can not restart ' );
    Exit;
  end;
  JHook : = SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0 );
  {SetWindowsHookEx starts the Hook}
   if JHook > 0 then
  begin
    FHookStarted : = True;
  end
   else
    ShowMessage( ' No Journal Hook availible ' );
end;

procedure TForm1.Button_StopJourClick(Sender: TObject);
begin
  FHookStarted : = False;
  UnhookWindowsHookEx(JHook);
  JHook : = 0 ;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  {the journal hook is automaticly camceled if the Task manager
  (Ctrl - Alt - Del) or the Ctrl - Esc keys are pressed, you restart it
  when the WM_CANCELJOURNAL is sent to the parent window, Application}
  Handled : = False;
   if (Msg.message = WM_CANCELJOURNAL) and FHookStarted then
    JHook : = SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0 , 0 );
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  {make sure you unhook it if the app closes}
   if FHookStarted then
    UnhookWindowsHookEx(JHook);
end;

end.

本文转自 OldHawk 博客园博客，原文链接：http://www.cnblogs.com/taobataoma/archive/2007/08/20/862686.html，如需转载请自行联系原作者

Trap mouse events outside of my application

热门文章

最新文章

相关电子书

热门

活动广场

任务中心

开发者评测

高校计划

乘风者计划

训练营

阿里云MVP

话题

直播

下载

镜像站

技术资料

插件

Trap mouse events outside of my application

热门文章

最新文章

相关电子书