MG: gtk mlouse events can now be fetched before or after

git-svn-id: trunk@2021 -
This commit is contained in:
lazarus 2002-08-17 23:40:40 +00:00
parent 6655ed568d
commit 4bb43f437e

View File

@ -512,13 +512,10 @@ begin
end;
{-------------------------------------------------------------------------------
GTKMotionNotify
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
Called whenever the mouse is moved over a widget.
The gtk event is translated into a lcl MouseMove message.
procedure DeliverMouseMoveMessage(Widget:PGTKWidget; Event: PGDKEventMotion;
AWinControl: TWinControl);
Translate a gdk mouse motion event into a LCL mouse move message and send it.
Mouse coordinate mapping:
@ -537,39 +534,16 @@ end;
If the mouse is on the top-left pixel of the container widget then the
coordinates can be negative, if there is frame around the client area.
-------------------------------------------------------------------------------}
function gtkMotionNotify(Widget:PGTKWidget; Event: PGDKEventMotion;
Data: gPointer): GBoolean; cdecl;
procedure DeliverMouseMoveMessage(Widget:PGTKWidget; Event: PGDKEventMotion;
AWinControl: TWinControl);
var
Msg: TLMMouseMove;
ShiftState: TShiftState;
MappedXY: TPoint;
DesignOnlySignal: boolean;
begin
Result:=true;
{$IFDEF VerboseMouseBugfix}
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion);
writeln('[GTKMotionNotify] ',
TControl(Data).Name,':',TControl(Data).ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' DSO=',DesignOnlySignal,
' Event^.X=',trunc(Event^.X),' Event^.Y=',trunc(Event^.Y)
);
{$ENDIF}
CheckMouseCaptureHandle(Widget);
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion);
if DesignOnlySignal then exit;
end else begin
// stop the signal, so that the widget does not auto react
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'motion-notify-event');
end;
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,
Point(trunc(Event^.X),trunc(Event^.Y)),
PGtkWidget(TWinControl(Data).Handle));
PGtkWidget(AWinControl.Handle));
ShiftState := GTKEventState2ShiftState(Event^.State);
with Msg do
@ -592,8 +566,59 @@ begin
// send the message directly to the LCL
// (Posting the message via queue
// has the risk of getting out of sync with the gtk)
DeliverMessage(Data, Msg);
//DeliverPostMessage(Data,Msg);
DeliverMessage(AWinControl, Msg);
end;
{-------------------------------------------------------------------------------
function ControlGetsMouseMoveBefore(AControl: TControl): boolean;
Returns true, if mouse move event should be sent before the widget istelf
reacts.
-------------------------------------------------------------------------------}
function ControlGetsMouseMoveBefore(AControl: TControl): boolean;
begin
// currently there are no controls, that need after events.
Result:=true;
end;
{-------------------------------------------------------------------------------
GTKMotionNotify
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
Called whenever the mouse is moved over a widget.
The gtk event is translated into a lcl MouseMove message.
-------------------------------------------------------------------------------}
function gtkMotionNotify(Widget:PGTKWidget; Event: PGDKEventMotion;
Data: gPointer): GBoolean; cdecl;
var
DesignOnlySignal: boolean;
begin
Result:=true;
{$IFDEF VerboseMouseBugfix}
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion);
writeln('[GTKMotionNotify] ',
TControl(Data).Name,':',TControl(Data).ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' DSO=',DesignOnlySignal,
' Event^.X=',trunc(Event^.X),' Event^.Y=',trunc(Event^.Y)
);
{$ENDIF}
CheckMouseCaptureHandle(Widget);
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion);
if DesignOnlySignal then exit;
if not ControlGetsMouseMoveBefore(TControl(Data)) then exit;
end else begin
// stop the signal, so that the widget does not auto react
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'motion-notify-event');
end;
DeliverMouseMoveMessage(Widget,Event,TWinControl(Data));
end;
{-------------------------------------------------------------------------------
@ -616,17 +641,37 @@ begin
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'motion-notify-event');
CheckMouseCaptureHandle(Widget);
if (csDesigning in TComponent(Data).ComponentState) then exit;
if ControlGetsMouseMoveBefore(TControl(Data)) then exit;
DeliverMouseMoveMessage(Widget,Event,TWinControl(Data));
end;
{-------------------------------------------------------------------------------
gtkMouseBtnPress
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
function ControlGetsMouseDownBefore(AControl: TControl): boolean;
Called whenever the mouse is over a widget and a mouse button is pressed.
Returns true, if mouse down event should be sent before the widget istelf
reacts.
-------------------------------------------------------------------------------}
function gtkMouseBtnPress(widget: PGtkWidget; event : pgdkEventButton;
data: gPointer) : GBoolean; cdecl;
function ControlGetsMouseDownBefore(AControl: TControl): boolean;
begin
case AControl.fCompStyle of
csCheckBox:
Result:=false;
else
Result:=true;
end;
end;
{-------------------------------------------------------------------------------
procedure DeliverMouseDownMessage(widget: PGtkWidget; event : pgdkEventButton;
AWinControl: TWinControl);
Translate a gdk mouse press event into a LCL mouse down message and send it.
-------------------------------------------------------------------------------}
procedure DeliverMouseDownMessage(widget: PGtkWidget; event : pgdkEventButton;
AWinControl: TWinControl);
const
WHEEL_DELTA : array[Boolean] of Integer = (-1, 1);
var
@ -635,7 +680,6 @@ var
ShiftState: TShiftState;
MappedXY: TPoint;
EventXY: TPoint;
DesignOnlySignal: boolean;
{ $DEFINE VerboseMouseBugfix}
@ -734,7 +778,7 @@ var
LastMouse.Window := Event^.Window;
LastMouse.WindowPoint := EventXY;
LastMouse.Down := True;
LastMouse.Component:=TComponent(Data);
LastMouse.Component:=AWinControl;
case LastMouse.ClickCount of
1: MessI.Msg := MsgNormal;
@ -749,47 +793,10 @@ var
end;
begin
Result:=true;
{$IFDEF VerboseMouseBugfix}
writeln('');
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
writeln('[gtkMouseBtnPress] ',
TComponent(Data).Name,':',TObject(Data).ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' ControlWidget=',HexStr(Cardinal(TWinControl(Data).Handle),8),
' DSO=',DesignOnlySignal,
' ',Trunc(Event^.X),',',Trunc(Event^.Y),
' Type=',Event^.theType);
{$ENDIF}
//writeln('DDD1 MousePress Widget=',HexStr(Cardinal(Widget),8),
//' ClientWidget=',HexStr(Cardinal(GetFixedWidget(Widget)),8),
//' EventMask=',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8),
//' GDK_BUTTON_RELEASE_MASK=',HexStr(Cardinal(GDK_BUTTON_RELEASE_MASK),8),
//' Window=',HexStr(Cardinal(Widget^.Window),8)
//);
//if GetFixedWidget(Widget)<>nil then
// writeln('DDD2 ClientWindow=',HexStr(Cardinal(PGtkWidget(GetFixedWidget(Widget))^.Window),8));
EventTrace('Mouse button Press', data);
Assert(False, Format('Trace:[gtkMouseBtnPress] ', []));
CheckMouseCaptureHandle(Widget);
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
if DesignOnlySignal then exit;
end else begin
// stop the signal, so that the widget does not auto react
if (TControl(Data).FCompStyle<>csNotebook)
or (event^.Button<>1) then
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-press-event');
end;
EventXY:=Point(trunc(Event^.X),trunc(Event^.Y));
ShiftState := GTKEventState2ShiftState(Event^.State);
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
PGtkWidget(TWinControl(Data).Handle));
PGtkWidget(AWinControl.Handle));
if event^.Button in [4,5] then begin
// this is a mouse wheel event
@ -798,14 +805,13 @@ begin
MessE.X := MappedXY.X;
MessE.Y := MappedXY.Y;
MessE.State := ShiftState;
MessE.UserData := Data;
MessE.UserData := AWinControl;
MessE.Button := 0;
// send the message directly to the LCL
// (Posting the message via queue
// has the risk of getting out of sync with the gtk)
//DeliverPostMessage(Data, MessE);
DeliverMessage(Data, MessE);
DeliverMessage(AWinControl, MessE);
end
else begin
// a normal mouse button is pressed
@ -847,11 +853,63 @@ begin
// send the message directly to the LCL
// (Posting the message via queue
// has the risk of getting out of sync with the gtk)
//DeliverPostMessage(Data, MessI);
DeliverMessage(Data, MessI);
DeliverMessage(AWinControl, MessI);
end;
end;
{-------------------------------------------------------------------------------
gtkMouseBtnPress
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
Called whenever the mouse is over a widget and a mouse button is pressed.
-------------------------------------------------------------------------------}
function gtkMouseBtnPress(widget: PGtkWidget; event : pgdkEventButton;
data: gPointer) : GBoolean; cdecl;
var
DesignOnlySignal: boolean;
begin
Result:=true;
{$IFDEF VerboseMouseBugfix}
writeln('');
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
writeln('[gtkMouseBtnPress] ',
TComponent(Data).Name,':',TObject(Data).ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' ControlWidget=',HexStr(Cardinal(TWinControl(Data).Handle),8),
' DSO=',DesignOnlySignal,
' ',Trunc(Event^.X),',',Trunc(Event^.Y),
' Type=',Event^.theType);
{$ENDIF}
//writeln('DDD1 MousePress Widget=',HexStr(Cardinal(Widget),8),
//' ClientWidget=',HexStr(Cardinal(GetFixedWidget(Widget)),8),
//' EventMask=',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8),
//' GDK_BUTTON_RELEASE_MASK=',HexStr(Cardinal(GDK_BUTTON_RELEASE_MASK),8),
//' Window=',HexStr(Cardinal(Widget^.Window),8)
//);
//if GetFixedWidget(Widget)<>nil then
// writeln('DDD2 ClientWindow=',HexStr(Cardinal(PGtkWidget(GetFixedWidget(Widget))^.Window),8));
EventTrace('Mouse button Press', data);
Assert(False, Format('Trace:[gtkMouseBtnPress] ', []));
CheckMouseCaptureHandle(Widget);
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
if DesignOnlySignal then exit;
if not ControlGetsMouseDownBefore(TControl(Data)) then exit;
end else begin
// stop the signal, so that the widget does not auto react
if (TControl(Data).FCompStyle<>csNotebook)
or (event^.Button<>1) then
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-press-event');
end;
DeliverMouseDownMessage(Widget,Event,TWinControl(Data));
end;
{-------------------------------------------------------------------------------
gtkMouseBtnPressAfter
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
@ -871,26 +929,45 @@ begin
' ',Trunc(Event^.X),',',Trunc(Event^.Y));}
{$ENDIF}
CheckMouseCaptureHandle(Widget);
// stop the signal, so that it is not sent to the parent widgets
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-press-event');
CheckMouseCaptureHandle(Widget);
if (csDesigning in TComponent(Data).ComponentState) then exit;
if ControlGetsMouseDownBefore(TControl(Data)) then exit;
DeliverMouseDownMessage(Widget,Event,TWinControl(Data));
end;
{-------------------------------------------------------------------------------
gtkMouseBtnRelease
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
function ControlGetsMouseUpBefore(AControl: TControl): boolean;
Called whenever the mouse is over a widget and a mouse button is released.
Returns true, if mouse up event should be sent before the widget istelf
reacts.
-------------------------------------------------------------------------------}
function gtkMouseBtnRelease(widget: PGtkWidget; event : pgdkEventButton;
data: gPointer) : GBoolean; cdecl;
function ControlGetsMouseUpBefore(AControl: TControl): boolean;
begin
case AControl.fCompStyle of
csCheckBox:
Result:=false;
else
Result:=true;
end;
end;
{-------------------------------------------------------------------------------
procedure DeliverMouseUpMessage(widget: PGtkWidget; event : pgdkEventButton;
AWinControl: TWinControl);
Translate a gdk mouse release event into a LCL mouse up message and send it.
-------------------------------------------------------------------------------}
procedure DeliverMouseUpMessage(widget: PGtkWidget; event : pgdkEventButton;
AWinControl: TWinControl);
var
MessI : TLMMouse;
ShiftState: TShiftState;
MappedXY: TPoint;
DesignOnlySignal: boolean;
function CheckMouseButtonUp(var LastMouse: TLastMouseClick;
MsgUp: longint): boolean;
@ -901,37 +978,9 @@ var
end;
begin
Result:=true;
{$IFDEF VerboseMouseBugfix}
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
writeln('[gtkMouseBtnRelease] A ',
TComponent(Data).Name,':',TObject(Data).ClassName,' ',
' Widget=',HexStr(Cardinal(Widget),8),
' DSO=',DesignOnlySignal,
' ',Trunc(Event^.X),',',Trunc(Event^.Y),' Btn=',event^.Button);
{$ENDIF}
//writeln('EEE1 MouseRelease Widget=',HexStr(Cardinal(Widget),8),
//' EventMask=',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8),
//' GDK_BUTTON_RELEASE_MASK=',HexStr(Cardinal(GDK_BUTTON_RELEASE_MASK),8));
CheckMouseCaptureHandle(Widget);
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
if DesignOnlySignal then exit;
end else begin
// stop the signal, so that the widget does not auto react
if TControl(Data).FCompStyle<>csNotebook then
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-release-event');
end;
EventTrace('Mouse button release', data);
Assert(False, Format('Trace:[gtkMouseBtnRelease] ', []));
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,
Point(trunc(Event^.X),trunc(Event^.Y)),
PGtkWidget(TWinControl(Data).Handle));
PGtkWidget(AWinControl.Handle));
case event^.Button of
@ -966,12 +1015,53 @@ begin
// send the message directly to the LCL
// (Posting the message via queue
// has the risk of getting out of sync with the gtk)
//DeliverPostMessage(Data, MessI);
MessI.Result := 0;
DeliverMessage(Data, MessI);
DeliverMessage(AWinControl, MessI);
end;
end;
{-------------------------------------------------------------------------------
gtkMouseBtnRelease
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
Called whenever the mouse is over a widget and a mouse button is released.
-------------------------------------------------------------------------------}
function gtkMouseBtnRelease(widget: PGtkWidget; event : pgdkEventButton;
data: gPointer) : GBoolean; cdecl;
var
DesignOnlySignal: boolean;
begin
Result:=true;
{$IFDEF VerboseMouseBugfix}
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
writeln('[gtkMouseBtnRelease] A ',
TComponent(Data).Name,':',TObject(Data).ClassName,' ',
' Widget=',HexStr(Cardinal(Widget),8),
' DSO=',DesignOnlySignal,
' ',Trunc(Event^.X),',',Trunc(Event^.Y),' Btn=',event^.Button);
{$ENDIF}
//writeln('EEE1 MouseRelease Widget=',HexStr(Cardinal(Widget),8),
//' EventMask=',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8),
//' GDK_BUTTON_RELEASE_MASK=',HexStr(Cardinal(GDK_BUTTON_RELEASE_MASK),8));
CheckMouseCaptureHandle(Widget);
if not (csDesigning in TComponent(Data).ComponentState) then begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
if DesignOnlySignal then exit;
if not ControlGetsMouseUpBefore(TControl(Data)) then exit;
end else begin
// stop the signal, so that the widget does not auto react
if TControl(Data).FCompStyle<>csNotebook then
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-release-event');
end;
DeliverMouseUpMessage(Widget,Event,TWinControl(Data));
end;
{-------------------------------------------------------------------------------
gtkMouseBtnReleaseAfter
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
@ -994,8 +1084,15 @@ begin
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-release-event');
CheckMouseCaptureHandle(Widget);
if (csDesigning in TComponent(Data).ComponentState) then exit;
if ControlGetsMouseUpBefore(TControl(Data)) then exit;
DeliverMouseUpMessage(Widget,Event,TWinControl(Data));
end;
function gtkclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
@ -2255,6 +2352,9 @@ end;
{ =============================================================================
$Log$
Revision 1.128 2002/09/16 08:54:03 lazarus
MG: gtk mlouse events can now be fetched before or after
Revision 1.127 2002/09/10 06:49:19 lazarus
MG: scrollingwincontrol from Andrew