Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Mausklick und Mausstrecke (https://www.delphipraxis.net/61974-mausklick-und-mausstrecke.html)

mOzZzI 29. Jan 2006 00:00


Mausklick und Mausstrecke
 
Hai,

hab mal ne Frage wollte mal so ein Programm machen, der die Klicks der Maus zählt und die Strecke der Maus berechnet...

Bis jetzt bin ich mit der Suche noch nicht weitergekommen... :roll:

TStringlist 29. Jan 2006 08:15

Re: Mausklick und Mausstrecke
 
Geeignet wäre dafür entweder ein TApplicationEvents (hier eine Ereignisbehandlungsroutine fürs OnMessage) oder ein localer Hook. Des geringeren Aufwands wegen, würde ich es aber zuerst mal mit ersterem versuchen. Eines auf irgendeiner Form müsste dann für deine Zwecke reichen. (Imo beinhaltet so ein TApplicationEvents-Objekt intern ja auch selbst nur so etwas wie einen solchen Hook).

edit: Ok, ein localer MousHook ist für dich vielleicht doch noch minimal besser. Zumindest in der Situation, in der du mit einer gedrückten MouseButton dann mal eine ScrollBar einer anderen Komponente verschieben solltest und auch diese Strecke noch wissen möchtest. Ein TApplicationEvents liefert in diesem Spezialfall :-) nämlich leider keine Message, ein solcher Hook aber schon.

mOzZzI 29. Jan 2006 13:42

Re: Mausklick und Mausstrecke
 
Also, ich habe jetzt so einen Mouse Hook...

Delphi-Quellcode:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FHookStarted : Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Mit:Boolean;

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.paramL> Screen.Width-2 then SetCursorPos(2,EventStrut.paramH);
     if EventStrut.paramL< 2 then SetCursorPos(Screen.Width-2,EventStrut.paramH);
     if EventStrut.paramH> Screen.Height -2 then SetCursorPos(EventStrut.paramL,2);
     if EventStrut.paramH< 2 then SetCursorPos(EventStrut.paramL,Screen.Height -2);

    if s <> '' then
       Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(s);
  end;
end;

procedure TForm1.Button1Click(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.Button2Click(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.
So jetzt möchte ich gerne das wenn eine MouseUp und ein MouseDown Message bekomme das in einen Label
dann gezählt wird wie oft dieser Vorgang passiert...
z.B. Maus macht "Klick" Label1.Caption:= 'Mausklick(s)1' und wenn man wieder eine Message bekommt soll dann die Caption vom Label dann logischerweiße 'Mausklick(s)2' haben... :gruebel:

Khabarakh 29. Jan 2006 14:09

Re: Mausklick und Mausstrecke
 
Und wo ist die Frage? Es sollte einem doch schnell ins Auge fallen, bei welchem Teil des Codes der Hook ausgewertet wird.

mOzZzI 29. Jan 2006 14:27

Re: Mausklick und Mausstrecke
 
Zitat:

Zitat von Khabarakh
Und wo ist die Frage? Es sollte einem doch schnell ins Auge fallen, bei welchem Teil des Codes der Hook ausgewertet wird.

Ja also di Frage ist ja wie ich das mit dem label hinbekomm...
Soll ich dann jedes mal das Labek neu schreiben?, oder wie geht das...

TStringlist 29. Jan 2006 15:30

Re: Mausklick und Mausstrecke
 
Das was du da ausgegraben hast ist übrigens kein Mousehook, sondern so wie es auch drübersteht ein Journal-Hook (WH_JOURNALRECORD).

Also, so etwas kann auch viel einfacher aussehen:

Delphi-Quellcode:
var
  Form1: TForm1;
  LButtonDownCounter,
  LButtonUpCounter : integer;

implementation

{$R *.dfm}

function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  case nCode < 0 of
  True:
    Result := CallNextHookEx(Form1.HookID, nCode, wParam, lParam)
  else begin

    case wParam of
      WM_LBUTTONDOWN : begin
                         inc(LButtonDownCounter);
                         form1.label1.caption := IntToStr(LButtonDownCounter)
                       end;
      WM_LBUTTONUP  : begin
                         inc(LButtonUpCounter);
                         form1.label2.caption := IntToStr(LButtonUpCounter)
                       end;
    end; { of case }
    Result := CallNextHookEx(Form1.HookID, nCode, wParam, lParam); end

  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
  LButtonDownCounter := 0;
  LButtonUpCounter := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if HookID <> 0 then
     UnHookWindowsHookEx(HookID);
end;

mOzZzI 29. Jan 2006 15:52

Re: Mausklick und Mausstrecke
 
Zitat:

Zitat von TStringlist
Das was du da ausgegraben hast ist übrigens kein Mousehook, sondern so wie es auch drübersteht ein Journal-Hook (WH_JOURNALRECORD).

Also, so etwas kann auch viel einfacher aussehen:

Delphi-Quellcode:
var
  Form1: TForm1;
  LButtonDownCounter,
  LButtonUpCounter : integer;

implementation

{$R *.dfm}

function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  case nCode < 0 of
  True:
    Result := CallNextHookEx(Form1.HookID, nCode, wParam, lParam)
  else begin

    case wParam of
      WM_LBUTTONDOWN : begin
                         inc(LButtonDownCounter);
                         form1.label1.caption := IntToStr(LButtonDownCounter)
                       end;
      WM_LBUTTONUP  : begin
                         inc(LButtonUpCounter);
                         form1.label2.caption := IntToStr(LButtonUpCounter)
                       end;
    end; { of case }
    Result := CallNextHookEx(Form1.HookID, nCode, wParam, lParam); end

  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
  LButtonDownCounter := 0;
  LButtonUpCounter := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if HookID <> 0 then
     UnHookWindowsHookEx(HookID);
end;

Mein einziges problem ist jetzt noch das men Compiler meldet Undefinierter Bezeichner: 'HookID'

Was hab ich falsch geamcht?

TStringlist 29. Jan 2006 15:59

Re: Mausklick und Mausstrecke
 
Da fehlte in der Variablen-Deklaration nur noch die Zeile:

Delphi-Quellcode:
  HookID: Cardinal;
(Ich hatte die in meinem kleinen Testprogramm unter 'private' in TForm1 deklariert).

mOzZzI 29. Jan 2006 16:06

Re: Mausklick und Mausstrecke
 
Delphi-Quellcode:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    HookID: Cardinal;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  LButtonDownCounter,
  LButtonUpCounter : integer;
  RButtonDownCounter,
  RButtonUpCounter : integer;

implementation

{$R *.dfm}

function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  case nCode < 0 of
  True:
    Result := CallNextHookEx(Form1.HookID, nCode, wParam, lParam)
  else begin

    case wParam of
      WM_LBUTTONDOWN : begin
                         inc(LButtonDownCounter);
                         form1.label1.caption := IntToStr(LButtonDownCounter)
                       end;
      WM_RBUTTONDOWN : begin
                         inc(RButtonDownCounter);
                         form1.Label2.Caption := InttoStr(RButtonDownCounter)
                       end;

    end; { of case }
    Result := CallNextHookEx(Form1.HookID, nCode, wParam, lParam); end

  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
  LButtonDownCounter := 0;
  LButtonUpCounter := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if HookID <> 0 then
     UnHookWindowsHookEx(HookID);
end;
Seltsamer Fehler, :gruebel:
der Fehler ist so ich möchte meine Mausklicks trennen Rechts/Linksklicks...
Klappt auch aber der Counter springt erst beim 2 Klick der Maus an und dann wenn man weiter klickt zählt der Counter nur jede zwei Klicks :gruebel:
Komisch...Sieht jemand den Fehler?

TStringlist 29. Jan 2006 16:20

Re: Mausklick und Mausstrecke
 
wenn du die Mausklicks getrennt zählen willst, dann musst du auch jeweils getrennt nach den dafür zuständigen Messages abfragen, als da wären z.B.:

WM_LButtonDown, WM_LButtonUp, WM_RButtonDown, WM_RButtonUp usw. usf...

Das nur jeder zweite Klick gezählt wird, liegt bestimmt daran, dass du die linke Maustaste zu schnell hintereinander betätigst. Dadurch wird beim jeweils zweiten Male keine weiteres WM_LButtonDown ausgelöst, sondern ein WM_LButtonDblClk. Das heißt also, wenn du zu schnell hintereinander die linke Maustaste betätigst erzeugts du keinen weiteren Klick mehr, sondern ganz normal dann einen Doppelklick.


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:17 Uhr.
Seite 1 von 2  1 2      

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