AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Bildschirmweites OnMouseMove gesucht

Offene Frage von "Nelphin"
Ein Thema von Nelphin · begonnen am 21. Dez 2009 · letzter Beitrag vom 21. Dez 2009
Antwort Antwort
Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#1

Re: Bildschirmweites OnMouseMove gesucht

  Alt 21. Dez 2009, 20:50
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.
Angehängte Dateien
Dateityp: zip llmousehooksample_822.zip (214,3 KB, 31x aufgerufen)
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:52 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz