Einzelnen Beitrag anzeigen

schöni

Registriert seit: 23. Jan 2005
Ort: Dresden
445 Beiträge
 
Delphi 7 Personal
 
#1

Unit Winmouse -> MouseButtons werden nicht erkannt

  Alt 23. Okt 2014, 20:44
Hallo,

hier soll es nochmals um Ereignisse gehen. Ich verwende jetzt für meinen Test in Lazarus auf der Konsole die Unit Winmouse. Die Unit Mouse erzeugt mir eine SIGSEGV Exception, obwohl es diese Unit sowohl für go32 (DOS) als auch für Windows gibt. Ich habe daher keine andere Möglichkeit gesehen, als Winmouse zu verwenden und meine GetMouseEvent- Funktion anzupassen.

Habe mich schon einmal mit Erignissen und deren Verteilung beschäftigt und zwar hier:

http://www.delphipraxis.net/182238-e...ml#post1277240

So hier:

Delphi-Quellcode:
function GetMouseEvent(var Event: TMouseEvStruct): TMouseEventKind;
var X,Y,Buttons: Longint; wasmoved: Boolean;
begin
   GetMouseEvent := evmNone;

   GetMouseState(X, Y, Buttons);

   wasmoved := ((mosex-x)<>0) or ((mousey-y)<>0)

   mousex := X;
   mousey := Y;

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

   Event.Buttons := Buttons;

   if Event.Buttons <> 0 then
   begin
     ___pressed_mouse_:= true;
     Event.EventKind := evmMouseDown;
     GetMouseEvent := evmMouseDown;
   end;

   if ___pressed_mouse_ and (Event.Buttons = 0) then
   begin
     ___pressed_mouse_:= false;
     Event.EventKind := evmMouseUp;
     GetMouseEvent := evmMouseUp;
   end;

   Event.Moved := wasmoved;

   if Event.Moved then Event.EventKind := evmMouseMove;

   Event.Cursor := 0; { sp„ter anpassen }
end;
Ich gehe davon aus, das X und Y korrekt ankommen, denn MouseMove Ereignisse kommen korrekt an, so muss also gemäß meinem Code auch X und Y korrekt ankommen, damit die obige Berechnung funktioniert.

Was aber immer noch nicht funktioniert, ist die Erennung der Maustasten.

Buttons ist immer gleich 0

Hier ist derQuellcode der Unit Wingraph aus Freepascal 2.6.0

Delphi-Quellcode:
unit winmouse;

  interface
    { initializes the mouse with the default values for the current screen mode }
    Function InitMouse:Boolean;

    { shows mouse pointer,text+graphics screen support }
    Procedure ShowMouse;

    { hides mouse pointer }
    Procedure HideMouse;

    { reads mouse position in pixels (divide by 8 to get text position in standard
      text mode) and reads the buttons state:
        bit 1 set -> left button pressed
        bit 2 set -> right button pressed
        bit 3 set -> middle button pressed
      Have a look at the example program in the manual to see how you can use this }

    Procedure GetMouseState(var x,y, buttons :Longint);

    { returns true if the left button is pressed }
    Function LPressed:Boolean;

    { returns true if the right button is pressed }
    Function RPressed:Boolean;

    { returns true if the middle button is pressed }
    Function MPressed:Boolean;

(*!!!!! the following functions aren't implemented yet:
hab ich deshalb weggelassen
*)


    Const
       LButton = 1; { left button   }
       RButton = 2; { right button  }
       MButton = 4; { middle button }

    Var
       MouseFound: Boolean;

  implementation

    uses
       windows,graph;

    var
       oldexitproc : pointer;
       mousebuttonstate : byte;

    function InitMouse : boolean;

      begin
         InitMouse:=MouseFound;
      end;

    procedure ShowMouse;

      begin
         Windows.ShowCursor(true);
      end;

    procedure HideMouse;

      begin
         Windows.ShowCursor(false);
      end;

    function msghandler(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): LResult; stdcall;

      begin
         { we catch the double click messages here too, }
         { even if they never appear because the graph  }
         { windows doesn't have the cs_dblclks flags    }
         case amessage of
            wm_lbuttondblclk,
            wm_lbuttondown:
              mousebuttonstate:=mousebuttonstate or LButton;
            wm_rbuttondblclk,
            wm_rbuttondown:
              mousebuttonstate:=mousebuttonstate or RButton;
            wm_mbuttondblclk,
            wm_mbuttondown:
              mousebuttonstate:=mousebuttonstate or MButton;
            wm_lbuttonup:
              mousebuttonstate:=mousebuttonstate and not(LButton);
            wm_rbuttonup:
              mousebuttonstate:=mousebuttonstate and not(RButton);
            wm_mbuttonup:
              mousebuttonstate:=mousebuttonstate and not(MButton);
         end;
         msghandler:=0;
      end;

    Function LPressed : Boolean;

      begin
         LPressed:=(mousebuttonstate and LButton)<>0;
      end;

    Function RPressed : Boolean;

      begin
         RPressed:=(mousebuttonstate and RButton)<>0;
      end;

    Function MPressed : Boolean;

      begin
         MPressed:=(mousebuttonstate and MButton)<>0;
      end;

    Procedure GetMouseState(var x,y,buttons : Longint);

      var
         pos : POINT;

      begin
         buttons:=mousebuttonstate;
         GetCursorPos(@pos);
         ScreenToClient(GraphWindow,@pos);
         x:=pos.x;
         y:=pos.y;
      end;

    procedure myexitproc;

      begin
         exitproc:=oldexitproc;
         mousemessagehandler:=nil;
      end;

  begin
     mousemessagehandler:=@msghandler;
     oldexitproc:=exitproc;
     exitproc:=@myexitproc;
     mousebuttonstate:=0;
     MouseFound:=GetSystemMetrics(SM_MOUSEPRESENT)<>0;
  end.
Auch LPressed, RPressed, MPressed arbeiten nicht korrekt. Daher gehe ich davon aus, das die Werte der MouseButtons nicht stimmen.

Oder ist was anderes an der Unit falsch?

Haben etwa die MouseButtons andere Werte? Ich arbeite mit Lazarus 1.6.0 unter Windows XP SP3.
Damit der Topf nicht explodiert, lässt man es ab und zu mal zischen.

Geändert von schöni (23. Okt 2014 um 20:50 Uhr)
  Mit Zitat antworten Zitat