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
Nelphin

Registriert seit: 2. Feb 2009
Ort: Kaiserslautern
71 Beiträge
 
Turbo Delphi für Win32
 
#1

Bildschirmweites OnMouseMove gesucht

  Alt 21. Dez 2009, 15:10
hi,

folgendes ProblemBeispiel)

Delphi-Quellcode:
procedure TForm1.Panel4MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var p:TPoint;
begin
  if (ssright in Shift) then //schreibe ich hier "ssleft in Shift", dann bekomme ich die Koordinaten auch dann aktualisiert, wenn ich ausserhalb des Panels bin. Bei ssright in Shift stoppt die Aktualisierung an den Panelgrenzen.
  begin
    GetCursorPos(P);
    panel3.Caption:=inttostr(p.x)+' '+inttostr(p.y);
  end;
end;
also wie im Kommentar erklärt verhält sich die OnMouseMove Geschichte anders, wenn ich die linke Maustaste drücke als wenn ich die rechte drücke... das Verhalten bei gedrückter linker maustaste gefällt mir besser und so hätte ich es auch gern wenn ich die rechte gedrückt halte.
ich könnte das jetzt zwar über einen timer umgehen (denke ich) aber wollte fragen ob es auch eleganter geht.
Ideal wäre schlicht ein bildschirmweites OnMouseMove, das ich durch ein onmousedown im panel aktiviere. Bei der Suche habe ich nichts passendes entdeckt.

Danke schonmal
  Mit Zitat antworten Zitat
Medium

Registriert seit: 23. Jan 2008
3.686 Beiträge
 
Delphi 2007 Enterprise
 
#2

Re: Bildschirmweites OnMouseMove gesucht

  Alt 21. Dez 2009, 15:34
Was du suchst ist ein Hier im Forum suchenMouse Hook.
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

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

Re: Bildschirmweites OnMouseMove gesucht

  Alt 21. Dez 2009, 15:49
Zitat von Medium:
Was du suchst ist ein Hier im Forum suchenMouse Hook.
oder besser ein low Level Mouse Hook.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
Medium

Registriert seit: 23. Jan 2008
3.686 Beiträge
 
Delphi 2007 Enterprise
 
#4

Re: Bildschirmweites OnMouseMove gesucht

  Alt 21. Dez 2009, 18:42
Da hadder Rescht!
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

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

Re: Bildschirmweites OnMouseMove gesucht

  Alt 21. Dez 2009, 21: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 13:38 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz