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.