Ereignisse werden nicht korrekt verteilt

[schöni]

Hallo,

ich beschäftige mich gerade mit der Verteilung von Ereignissen in Objekten. Ich habe dazu eine Unit geschrieben DControl (D)esigned Control(s). Dort gibt es die Klasse TCustomControl, die eine DispatchEvent-Methode enthält, die so aussieht:

Delphi-Quellcode:

procedure TCustomControl.DispatchEvents;
var Event: TMEBEvent; ix: Integer;
begin
  GetMEBEvent(Event);
  case Event.ofKbdEventKind of
   evkKeyDown:
    DoKeyDown(self, Event.ofKeyboard.VirtCode,Event.ofKeyboard.Shift);
   evkKeyUp:
    DoKeyUp(self, Event.ofKeyboard.VirtCode,Event.ofKeyboard.Shift);
   else ;
  end;
  case Event.ofKbdEventKind of
   evkKeyDown:
    DoKeyDown(self, Event.ofKeyboard.VirtCode,Event.ofKeyboard.Shift);
   evkKeyUp:
    DoKeyUp(self, Event.ofKeyboard.VirtCode,Event.ofKeyboard.Shift);
  end;
  case Event.ofMouse.EventKind of
   evmMouseDown:
    DoMouseDown(
       self, Event.ofMouse.MButtns,
       Event.ofKeyboard.Shift,
       Event.ofMouse.x,
       Event.ofMouse.y
     );
   evmMouseMove:
    DoMouseMove(
       self,
       Event.ofKeyboard.Shift,
       Event.ofMouse.x,
       Event.ofMouse.y
     );
   evmMouseUp:
    DoMouseUp(
       self, Event.ofMouse.MButtns,
       Event.ofKeyboard.Shift,
       Event.ofMouse.x,
       Event.ofMouse.y
     );
  end;
  ix := ComponentCount-1;
  while ix>=0 do
  begin
    case Event.ofKbdEventKind of
     evkKeyDown:
      TCustomControl(Components[ix]).DoKeyDown(self, Event.ofKeyboard.VirtCode,Event.ofKeyboard.Shift);
     evkKeyUp:
      TCustomControl(Components[ix]).DoKeyUp(self, Event.ofKeyboard.VirtCode,Event.ofKeyboard.Shift);
    end;
    case Event.ofMouse.EventKind of
     evmMouseDown:
      TCustomControl(Components[ix]).DoMouseDown(
       self, Event.ofMouse.MButtns,
       Event.ofKeyboard.Shift,
       Event.ofMouse.x,
       Event.ofMouse.y
     );
     evmMouseMove:
      TCustomControl(Components[ix]).DoMouseMove(
       self,
       Event.ofKeyboard.Shift,
       Event.ofMouse.x,
       Event.ofMouse.y
     );
     evmMouseUp:
      TCustomControl(Components[ix]).DoMouseUp(
       self, Event.ofMouse.MButtns,
       Event.ofKeyboard.Shift,
       Event.ofMouse.x,
       Event.ofMouse.y
     );
   end;
   Dec(ix);
  end;
end;

die DoKey.... Methoden rufen die passenden Key... Methoden auf.
die DoMouse.... Methoden tun das gleiche für die Mouse... Methoden.

die DoRun Methode meiner CustomApplication ist die hier:

Delphi-Quellcode:

procedure TMyCustApp.DoRun;
begin
  ...
  AControl := TTestControl.Create(self);
  repeat
    AControl.DispatchEvents;
  until Terminated;
  ...
end;

//Die GetMEBEVentMethode ---> MEB -> Marke Eigenbau :)

Delphi-Quellcode:

procedure GetMEBEvent(var Event: TMEBEvent);
begin
  Event.ofKbdEventKind := evkNone;
  Event.ofMouse.EventKind := evmNone;
  if {$ifndef FPC}crt.{$endif}keypressed then
  begin
    {KeyPress(Event.ofKeyboard.VirtCode, Event.ofKeyboard.Shift);}
    Event.ofKeyboard.CharCode := readKey;
    if Event.ofKeyboard.CharCode = #0 then Event.ofKeyboard.Scancode := ord(readKey);
    {$endif}
   Event.ofKeyboard.Left := (ssLeft IN Event.ofKeyboard.Shift);
    Event.ofKbdEventKind := evkKeyDown;
    ___pressed_key___:= true;
  end;
  if (not crt.keypressed) and ___pressed_key___ then
  begin
    Event.ofKbdEventKind := evkKeyUp;
    ___pressed_key___:= false;
  end;
  GetMouseEvent(Event.ofMouse);
end;


//nun die GetEvent Methode für die Musereignisse:
function GetMouseEvent(var Event: TMouseEvStruct): TMouseEventKind;
begin
  GetMouseEvent := evmNone;
  Event.x := AppMouse.GetX;
  Event.y := AppMouse.GetY;
  if AppMouse.Buttons = 1 then begin Event.Buttons := 1; Include(Event.MButtns, mbLeft); end;
  if AppMouse.Buttons = 2 then begin Event.Buttons := 2; Include(Event.MButtns, mbRight); end;
  if Event.Buttons <> 0 then
  begin
    ___pressed_mouse_:= true;
    Event.EventKind := evmMouseDown;
    GetMouseEvent := evmMouseDown;
  end;
  {if (not button(0)) and (not button(1)) then Event.Buttons := 0;}
  if ___pressed_mouse_ and (Event.Buttons = 0) then
  begin
    ___pressed_mouse_:= false;
    Event.EventKind := evmMouseUp;
    GetMouseEvent := evmMouseUp;
  end;
  Event.Moved := AppMouse.moved;
  if Event.Moved then Event.EventKind := evmMouseMove;
  Event.Cursor := 0; { sp&#8222;ter anpassen }
end;

Zur Maussteuerung verwende ich die Unit Winmouse aus Freepascal, die jedoch mit dieser Klasse gekapselt wird.

Delphi-Quellcode:

type
  TMouseDriverClass = Class(TObject)
  public
    constructor Init;
    function Buttons: {$ifdef FPC}Longint;{$else}Word;{$endif}
    destructor Done; virtual;
    function Error: Boolean;
    procedure Hide;
    procedure Show;
    procedure SetLimitRange(x1,y1,x2,y2: {$ifdef FPC}Longint{$else}word{$endif});
    procedure SetXY(X,Y: {$ifdef FPC}Longint{$else}word{$endif});
    procedure GetXY(var X, Y: {$ifdef FPC}Longint{$else}word{$endif});
    function GetX: {$ifdef FPC}Longint;{$else}word;{$endif}
    function GetY: {$ifdef FPC}Longint;{$else}word;{$endif}
    function InRect(x1,y1, x2,y2: {$ifdef FPC}Longint{$else}word{$endif}): Boolean;
    procedure LoadCursor(Index: Integer);
    function moved: Boolean;
    function DeltaX: Integer;
    function DeltaY: Integer;
  end;

Auf der Tastatur wird nur das Ereignis KeyUp, nicht aber KeyDown oder Keypress erkannt. Die Mausereignisse werden gar nicht erkannt. Auch die MausButtons werden nicht korrekt erkannt.

Was läuft da in meinem Quellcode falsch?

Gibt es eine besser geeignete Maus Unit.

Ich habe den Quellcode mit Lazarus geschrieben. Datei -> Neu -> Freepascal Konsolenprogramm.

[sx2008]

Ich würde die procedure

Delphi-Quellcode:

TCustomControl.DispatchEvents

in zwei Methoden splitten, dann kann man besser testen.

Delphi-Quellcode:

procedure TCustomControl.DispatchSingleEvent(Event: TMEBEvent);
var ix: Integer;
begin
  case Event.ofKbdEventKind of
   evkKeyDown:
...
end;  

procedure TCustomControl.DispatchEvents;
var Event: TMEBEvent; 
begin
  GetMEBEvent(Event);
  DispatchSingleEvent(Event);
end;

Und einige Event künstlich erzeugen und testen

Delphi-Quellcode:

procedure TMyCustApp.TestRun;
var E1,E2,E3: TMEBEvent;
begin
  ...
  AControl := TTestControl.Create(self);
  // Test Tastendruck
  E1.ofKbdEventKind := evkKeyDown;
  E1.Event.ofKeyboard.VirtCode := VK_A;
  AControl.DispatchSingleEvent(E1);
  // Test Mausklick
  E2... := ...;
  AControl.DispatchSingleEvent(E2);

  E3... := ...;
  AControl.DispatchSingleEvent(E3);
  ...
end;

[schöni]

Zitat:

Zitat von sx2008

Ich würde die procedure TCustomControl.DispatchEvents in zwei Methoden splitten...

Danke für den Tipp. Hab ich gemacht. Bei künstlicher Auslösung der Ereignisse werden alle Ereignisse korrekt weiter geleitet.

Warum KeyDown nicht ankommt, da muss ich also in GetMEBEvent schauen. Ebenso muss ich die Mausunit überprüfen. Werde wohl besser Mouse oder MsMouse verwenden. Aktuell verwende ich Winmouse aus Lazarus.

[schöni]

Da will ich mal hier den Link setzen zu dem Problem mit dem Titel:

Unit Winmouse -> MouseButtons werden nicht erkannt:

http://www.delphipraxis.net/182436-u...ml#post1277238

da es hier gerne gesehen wird, wenn ich Crosspostings als solche kennzeichne.

Leider kann ich meinen ersten Beitrag nicht mehr bearbeiten, sonst hätte ich diesen Link da hin gesetzt. Kann bitte einer der Moderatoren das nachholen?


Übrigens:

Die Tastaturereignisse kommen korrekt an.

@sx2008: Danke für den Tipp, Habe meinen Test so aufgebaut.