Unit Winmouse -> MouseButtons werden nicht erkannt

[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?