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„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.