Freeware: Multimonitor Software (QuickSwitch)

[stoxx]

Zitat von Zacherl:

Kleine Frage dazu .. du verwendest Hooks oder?

in dieser compilierten Version nicht, nein ... aber ich hab nun mehrere Varianten zur Auswahl
Die zwei Hook Typen, die dafür gut gewesen wären, funktionieren nicht mehr auf Vista.
(WH_JOURNALRECORD und WH_MOUSE_LL)
und der normale WH_MOUSE Hook hat den nachteil, dass man das Mouse Up Event nicht bekommt, wenn man bei gedrückter Maustaste den geklickten Bereich verlässt....
So habe ich mich für die GetAsyncState Polling Methode entschieden


Falls Dich der Quelltext interessiert .. ist ein stinknormaler Timer, ein angeblich etwas resourcenschonender Multimediatimer stürtze leider ab und zu ab ... es waren ihm irgendwie zuviele Stackaufrufe in der Callback Procedure ...
falls Dich die Unit interessiert ... hier der Code ...

Delphi-Quellcode:

unit xMouseHookVistaU;

// Version 1.0

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, xSystemTimerU, xClasses, ExtCtrls;




type


//==============================================================================

TMouseHook = class(TObject)
private

  BoolDelphiTimer : Boolean;
  LButtonIsDown : boolean;
  RButtonIsDown : Boolean;
  MButtonIsDown: boolean;
  LastPos : TPoint;                                                                                     


  EMouseDown, EMouseUp : TMouseEvent;
  EMouseMove : TMouseMoveEvent;

  FHookStarted : Boolean;
  FTimer : TSystemTimer;
  FTimerDelphi : TTimer;


  FEventMouseDownMMCaster : TMulticaster;
  FEventMouseUpMMCaster : TMulticaster;
  FEventMouseMoveMMCaster : TMulticaster;

  function GetShift : TShiftState;

  procedure OnTimer(Sender : TObject);
  procedure Set_EventMouseMove(const Value: TMouseMoveEvent);
  procedure Set_EventMouseDown(const Value: TMouseEvent);
  procedure Set_EventMouseUp(const Value: TMouseEvent);
  procedure CastMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  procedure CastMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  procedure CastMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
public

  constructor create;
  destructor destroy; override;
  function Start : Boolean;
  function stop : boolean;
  property Timer : TSystemTimer read FTimer;
  property EventMouseDown : TMouseEvent read EMouseDown write EMouseDown;
  property EventMouseUp  : TMouseEvent read EMouseUp write EMouseUp;
  property EventMouseMove : TMouseMoveEvent read EMouseMove write EMouseMove;
  procedure RemoveAllForAnObject(anObject: TObject);

end;

//==============================================================================

implementation

//==============================================================================



//==============================================================================

constructor TMouseHook.create;
begin
 inherited;
 BoolDelphiTimer := true;
 FEventMouseDownMMCaster := TMultiCaster.create(self);
 FEventMouseUpMMCaster := TMultiCaster.create(self);
 FEventMouseMoveMMCaster := TMultiCaster.Create(self);


 FHookStarted := False;

 LButtonIsDown := false;
 RButtonIsDown := false;
 MButtonIsDown := false;

 if BoolDelphiTimer then begin
     FTimerDelphi := TTimer.Create(nil);
     FTimerDelphi.Enabled := false;
     FtimerDelphi.OnTimer := self.OnTimer;
     FTimerDelphi.Interval := 50;

 end else begin

     FTimer := TSystemTimer.Create;
     FTimer.Interval := 10;
     FTimer.OnTimer := self.OnTimer;
 end;


end;

//==============================================================================

destructor TMouseHook.destroy;
begin

  if FHookStarted then self.stop;


  if BoolDelphiTimer then begin
       if Assigned(FTimerDelphi)
    then FTimerDelphi.Free;
  end else begin
    Timer.OnTimer := nil;

  end;

 FEventMouseDownMMCaster.free;
 FEventMouseUpMMCaster.free;
 FEventMouseMoveMMCaster.free;

  inherited;
end;

//==============================================================================

procedure TMouseHook.OnTimer(Sender : TObject);
var
    s : String;
    MouseButton : TMouseButton;

    X, Y   : Integer;
    Point : TPoint;


    NewLButtonIsDown, NewRButtonIsDown, NewMButtonIsDown : Boolean;
    i : Integer;


begin
   if not FHookStarted then exit;
    GetCursorPos(Point);

    X := Point.X;
    Y := Point.Y;

    NewLButtonIsDown := false;
    NewRButtonIsDown := false;
    NewMButtonIsDown := false;

        if (GetAsynckeyState(vk_lbutton) <> 0) then begin
         NewLButtonIsDown := True;
        end;


        if (GetAsynckeyState(vk_Rbutton) <> 0) then begin
         NewRButtonIsDown := true;
        end;

        if (GetAsynckeyState(vk_mbutton) <> 0) then begin
         NewMButtonIsDown := true;
        end;


//        for i := 0 to 10000 do  begin
//         if i = 145 then continue;
//            if (GetAsynckeyState(i ) <> 0) then begin
//            beep;
//            end;
//        end;

    //==========================================================================

    // Left Button Down
    if NewLButtonIsDown and not LButtonIsDown then begin
        LButtonIsDown := true;
        MouseButton := mbLeft;

        if Assigned(EMouseDown)
           then EMouseDown(self,MouseButton, GetShift,X, Y);
    end; // L Button Down


    // Left Button Up
    if not NewLButtonIsDown and  LButtonIsDown then begin
        LButtonIsDown := false;
        MouseButton := mbLeft;

        if Assigned(EMouseUP)
           then EMouseUP(self,MouseButton, GetShift,X, Y);

    end; // L Button Up

    //==========================================================================

    // Right Button Down
    if NewRButtonIsDown and not RButtonIsDown then begin
        RButtonIsDown := true;
        MouseButton := mbRight;

        if Assigned(EMouseDown)
           then EMouseDown(self,MouseButton, GetShift,X, Y);
    end;  // R Button Down

    // Right Button Up
    if not NewRButtonIsDown and RButtonIsDown then begin
        RButtonIsDown := false;
        MouseButton := mbRight;

        if Assigned(EMouseUP)
           then EMouseUP(self,MouseButton, GetShift,X, Y);
    end;  // R Button Up


    //==========================================================================

        // Middle Button Down
    if NewMButtonIsDown and not MButtonIsDown then begin
        MButtonIsDown := true;
        MouseButton := mbMiddle;

        if Assigned(EMouseDown)
           then EMouseDown(self,MouseButton, GetShift,X, Y);

    end;  // R Button Down

    // Middle Button Up
    if not NewMButtonIsDown and MButtonIsDown then begin
        MButtonIsDown := false;
        MouseButton := mbmiddle;

        if Assigned(EMouseUP)
           then EMouseUP(self,MouseButton, GetShift,X, Y);

    end;  // R Button Up

    //==========================================================================






//    // Mouse Wheel
//    if (EventStrut.message = WM_MOUSEWHEEL) then begin
//        s := 'Mouse Wheel at X pos ' +
//        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);
//    end; // Mouse Wheel

    //==========================================================================
    // Mouse Move
    if (X <> LastPos.x) or
       (Y <> LastPos.Y) then begin
        if Assigned(EMouseMove)
           then EMouseMove(Self, GetShift,X, Y);
    end; // MouseMove


    LastPos.X := x;
    LastPos.Y := y;


end; //  OnTimer  (TMouseHook)


//==============================================================================

function TMouseHook.GetShift : TShiftState;
begin
    result := [];
    if self.LButtonIsDown then Include(result,ssleft);
    if self.RButtonIsDown then Include(result,ssright);
    if self.MButtonIsDown then Include(result,ssmiddle);

end; //  SetShift  (TMouseHook)

//==============================================================================

function TMouseHook.Start : Boolean;
begin
  result := false;

      if FHookStarted then exit;

      if BoolDelphiTimer then begin
          FTimerDelphi.Enabled := true;
          FHookStarted := true;
      end else begin

        FTimer.StartTimer;
        FHookStarted := true;
      end;
      result := true;


end; //  Start  (TMouseHook)

//==============================================================================
function TMouseHook.stop : boolean;
begin
if BoolDelphiTimer then begin
    FTimerDelphi.Enabled := false;
    FHookStarted := false;
end else begin
    FTimer.StopTimer;
    FHookStarted := False;
end;

end; //  stop  (TMouseHook)

//==============================================================================
//==============================================================================
//==============================================================================

procedure TMouseHook.Set_EventMouseMove(const Value: TMouseMoveEvent);
begin
if not assigned(Value) then showmessage('Bitte remove benutzen') else
FEventMouseMoveMMCaster.add(TMethod(Value));
end;
//==============================================================================
procedure TMouseHook.Set_EventMouseDown(const Value: TMouseEvent);
begin
if not assigned(Value) then showmessage('Bitte remove benutzen') else
FEventMouseDownMMCaster.add(TMethod(Value));
end;
//==============================================================================
procedure TMouseHook.Set_EventMouseUp(const Value: TMouseEvent);
begin
if not assigned(Value) then showmessage('Bitte remove benutzen') else
FEventMouseUpMMCaster.add(TMethod(Value));
end;
//==============================================================================


//==============================================================================
// entfernt ein Object aus ALLEN Multicastern
//==============================================================================
procedure TMouseHook.RemoveAllForAnObject(anObject: TObject);
begin
  FEventMouseMoveMMCaster.RemoveAllForAnObject(anObject);
  FEventMouseDownMMCaster.RemoveAllForAnObject(anObject);
  FEventMouseUpMMCaster.RemoveAllForAnObject(anObject);

end;  // RemoveAllForAnObject

//==============================================================================
procedure TMouseHook.CastMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var i : Integer;
    Method : TMouseMoveEvent;
begin
 for i := 0 to FEventMouseMoveMMCaster.count - 1 do begin
    Method := TMouseMoveEvent(FEventMouseMoveMMCaster[i]);
    Method(Self, Shift, X, Y);
 end;
end;


//==============================================================================

procedure TMouseHook.CastMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i : Integer;
    Method : TMouseEvent;
begin
 for i := 0 to FEventMouseDownMMCaster.count - 1 do begin
    Method := TMouseEvent(FEventMouseDownMMCaster[i]);
    Method(Self, Button, Shift, X, Y);
 end;

end; // CastMouseDown

//==============================================================================

procedure TMouseHook.CastMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i : Integer;
    Method : TMouseEvent;
begin
 for i := 0 to FEventMouseUpMMCaster.count - 1 do begin
    Method := TMouseEvent(FEventMouseUpMMCaster[i]);
    Method(Self, Button, Shift, X, Y);
 end;

end; // CastMouseUp





end.