天天看点

Trap mouse events outside of my application

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} 

  JHook: THandle; 

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall; 

  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 ' + 

    if EventStrut.message = WM_RBUTTONDOWN then 

      s := 'Right Mouse Down at X pos ' + 

    if (EventStrut.message = WM_RBUTTONUP) then 

      s := 'Right Mouse Up at X pos ' + 

    if (EventStrut.message = WM_MOUSEWHEEL) then 

      s := 'Mouse Wheel at X pos ' + 

    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; 

procedure TForm1.Button_StartJourClick(Sender: TObject); 

  if FHookStarted then 

    ShowMessage('Mouse is already being Journaled, can not restart'); 

    Exit; 

  JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0); 

  {SetWindowsHookEx starts the Hook} 

  if JHook > 0 then 

    FHookStarted := True; 

  end 

  else 

    ShowMessage('No Journal Hook availible'); 

procedure TForm1.Button_StopJourClick(Sender: TObject); 

  FHookStarted := False; 

  UnhookWindowsHookEx(JHook); 

  JHook := 0; 

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; 

  var Handled: Boolean); 

  {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); 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 

  {make sure you unhook it if the app closes} 

    UnhookWindowsHookEx(JHook); 

end. 

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

继续阅读