Unit Winmouse -> MouseButtons werden nicht erkannt

[schöni]

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.

[schöni]

Hallo,

weitere Experimente haben ergeben das der msghandler zwar an mousemessagehandler zugewiesen, jedoch dann nicht aufgerufen wird.

Ist wohl dann ein Fehler in Freepascal. Leider kann ich mich jedoch wegen früherer Kritik an Aspekten der Open Source Philisophie im Bugtracker nicht einloggen. Deshalb bitte ich einen der Freepascla Programmierer hier im Forum, diesen Bug Report weiter zu leiten.

Ich habe Lazarus 1.6.0 mit Freepascal 1.6.0

Bitte teilt mir hier mit, wenn dieser Fehler schon beseitigt ist und wenn ja, dann welche FPC Version ich da runterladen muss.

Oder gibt es einen einfachen Workaround?

.

[himitsu]

Zitat von schöni:

Oder gibt es einen einfachen Workaround?

Ob es eine Alternative gibt, kann man schlecht sagen, wenn man nicht weiß wozu das Ding von dir benutzt werden sollte.

[schöni]

@himitsu:

Ich will derzeit ohne FCL oder anderes einfach sehen wie Ereignisse, die ich erzeuge, ankommen.

Sinn und Zweck des Ganzen ist zunächst die Erlangung von Verständnis darüber, wie die Ereignisse in mein konkretes Objekt kommen. Ich hatte vor längerer Zeit schon mal eine Frage hier gestellt. Der Titel des Threads war, glaub ich:

Da bekam ich den Tipp, in Forms die Methoden TCustomApplication.WndProc und TForm.Wndproc zu studieren.


Jetzt bin ich in einem Computerkurs und habe dort die Aufgabe, mit Freepascal ein Programm zu schreiben, das Maus- und Tastaturereignisse erzeugt. Ist eine Hausaufgabe im Computerkurs.

Ich soll dabei alles unwesentliche weglassen. Ich habe deshalb ein Windows Konsolenprogramm geschrieben, das nichts anderes macht, als Ereignisse entgegenzunehmen und dann auf der Konsole die Art des Ereigneisses per

Writeln('KeyDown ausgelöst');

oder

Writeln('MouseMove ausgelöst');

ausgibt.

Delphi-Quellcode:

program cgapp;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp, ptcGraph, DControls, Events, UEvIntf
  { you can add units after this };

type

  { TConApplication }

  TConApplication = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

  { TTestControl }

  TTestControl = class(TCustomControl)
    constructor Create(AOwner: TComponent);
    procedure KeyDown(Sender: TObject; Key: Word; Shift: TShiftState); override;
    procedure KeyUp(Sender: TObject; Key: Word; Shift: TShiftState); override;
    procedure KeyPress(Sender: TObject; Key: Char); override;
    procedure MouseDown(Sender: TObject; Buttons: TMouseButtons; Shift: TShiftState; X,Y: Integer); override;
    procedure MouseUp(Sender: TObject; Buttons: TMouseButtons; Shift: TShiftState; X,Y: Integer); override;
    procedure MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); override;
  end;

var
  AControl: TTestControl;

constructor TTestControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

procedure TTestControl.KeyDown(Sender: TObject; Key: Word; Shift: TShiftState);
begin
  if Lo(Key)=27 then TCustomApplication(Owner).Terminate;
  inherited KeyDown(Sender, Key, Shift);
end;

procedure TTestControl.KeyUp(Sender: TObject; Key: Word; Shift: TShiftState);
begin
  if Lo(Key)=27 then TCustomApplication(Owner).Terminate;
  inherited KeyUp(Sender, Key, Shift);
end;

procedure TTestControl.KeyPress(Sender: TObject; Key: Char);
begin
  if Key = #27 then TCustomApplication(Owner).Terminate;
  inherited KeyPress(Sender, Key);
end;

procedure TTestControl.MouseDown(Sender: TObject; Buttons: TMouseButtons;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Sender, Buttons, Shift, X, Y);
end;

procedure TTestControl.MouseUp(Sender: TObject; Buttons: TMouseButtons;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Sender, Buttons, Shift, X, Y);
end;

procedure TTestControl.MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseMove(Sender, Shift, X, Y);
end;

{ TConApplication }

procedure TConApplication.DoRun;
var
  ErrorMsg: String;
  Event: TDCLEvent;
begin
  // quick check parameters
  ErrorMsg:=CheckOptions('h','help');
  if ErrorMsg<>'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  // parse parameters
  if HasOption('h','help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  { add your program here }
  AControl := TTestControl.Create(self);
  repeat
    GetMyEvent(Event);
    AControl.DispatchSingleEvent(Event);
  until Terminated;
  // stop program loop
  //Terminate;
end;

constructor TConApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;

destructor TConApplication.Destroy;
begin
  inherited Destroy;
end;

procedure TConApplication.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ',ExeName,' -h');
end;

var
  Application: TConApplication;
begin
  Application:=TConApplication.Create(nil);
  Application.Title:='Console Show-Events Application';
  Application.Run;
  Application.Free;
end.

Das Windows API wird später eh noch ausführlich behandelt. Deshalb soll ich hier erst mal alles weglassen, was den Quellcode nur komplizierter macht.

Ich könnte natürlich, wenn gar nix anderes hilft, die MSG-Schleife des Win-Api nitzen:

while GetMessage do ...

aber vielleicht gibt es ja bis zur ausführlichen Behandlung des WinAPI im Kurs eine andere Möglichkeit, zumal die Tastaturereignisse alle korrekt ankommen und MouseMove mit der vorliegenden Unit ja auch ankommt. Warum aber werden die Buttons nicht erkannt.

Gibt es nicht eine WINAPI Funktion, die die MouseButtons abfragt?

Die Unit Winmouse nutzt die API Funktion GetCursorPos, um die X,Y Koordinaten zu erhalten.

Gibt es wirklich absolut keine so einfache WinAPI Funktion zum Erhalt der MausButtons. Hängt das wirklich sooo sehr vom konkreten Anwendungsfall ab????

Bin arg am Verzweifeln. Warum geht das alles nicht einfacher?