Bildschirmweites OnMouseMove gesucht

[turboPASCAL]

Auf Anfrage ein Beispiel:

- auf die Form ein Memo und ein Label "pappen".

Delphi-Quellcode:

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XPMan;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// --- Low Level Mouse Hook --------------------------------------------------

const
  WH_KEYBOARD_LL = 13;  // define for Delphi 6 and older Versions
  WH_MOUSE_LL    = 14;

type
  PMouseLLHookStruct = ^TMouseLLHookStruct;
  TMouseLLHookStruct = record
    pt: TPoint;
    mouseData: DWORD;
    Flags: DWORD;
    Time: DWORD;
    dwExtraInfo: Cardinal;
  end;

var
  hLLMouseHook: THandle;
  isHookInstalled: Boolean;

function LLMouseHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  pMouseHookData: PMouseLLHookStruct;
begin
  if (nCode = HC_ACTION) and (lParam <> 0) then
  begin
    pMouseHookData := PMouseLLHookStruct(lParam);

    case wParam of
      WM_LBUTTONDOWN: Form1.Memo1.Lines.Add('LMBtn down');
      WM_LBUTTONUP: Form1.Memo1.Lines.Add('LMBtn up');
      WM_RBUTTONDOWN: Form1.Memo1.Lines.Add('RMBtn down');
      WM_RBUTTONUP: Form1.Memo1.Lines.Add('RMBtn up');
      WM_MBUTTONDOWN: Form1.Memo1.Lines.Add('MMBtn down');
      WM_MBUTTONUP: Form1.Memo1.Lines.Add('MMBtn up');
      WM_MOUSEWHEEL:
        begin
          Form1.Memo1.Lines.Add('Mouse weel');
          if HIWORD(TMouseLLHookStruct(pMouseHookData^).mouseData) = 120
            then
            Form1.Memo1.Lines.Add(' -> mouseData: (Mousewheel up)')
          else
            Form1.Memo1.Lines.Add(' -> mouseData: (Mousewheel down)');
        end;
    end;
    Form1.Label1.Caption := format('X = %d, Y = %d', [TMouseLLHookStruct(pMouseHookData^).pt.X, TMouseLLHookStruct(pMouseHookData^).pt.Y]);
  end;

  Result := CallNextHookEx(hLLMouseHook, nCode, wParam, lParam);
end;

function InstallLLMouseHook: Boolean;
var
  isMouseHook: Boolean;
begin
  Result := False;

  if hLLMouseHook = 0 then
  begin
    hLLMouseHook := SetWindowsHookEx(WH_MOUSE_LL, LLMouseHookProc, hInstance, 0);
    Result := hLLMouseHook <> 0;
  end;

  isHookInstalled := Result;
end;

function UninstallHook: Boolean;
begin
  Result := False;

  if hLLMouseHook <> 0 then
  begin
    if UnhookWindowsHookEx(hLLMouseHook) then
    begin
      hLLMouseHook := 0;
      isHookInstalled := False;
      Result := not isHookInstalled;
    end;
  end;
end;

// --- TForm1 ----------------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;

  if not InstallLLMouseHook then
  begin
    Application.MessageBox('Sorry, Mousehook konnte nicht installiert werden.', '!', MB_ICONWARNING);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UninstallHook;
end;

end.