paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 17:19:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@2021 -
This commit is contained in:
lazarus 2002-08-17 23:40:40 +00:00
parent 6655ed568d
commit 4bb43f437e
1 changed files with 238 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

348
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -512,13 +512,10 @@ begin
end; end;
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
GTKMotionNotify procedure DeliverMouseMoveMessage(Widget:PGTKWidget; Event: PGDKEventMotion;
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer AWinControl: TWinControl);
Returns: GBoolean
Called whenever the mouse is moved over a widget.
The gtk event is translated into a lcl MouseMove message.
Translate a gdk mouse motion event into a LCL mouse move message and send it.
Mouse coordinate mapping: Mouse coordinate mapping:
@ -537,39 +534,16 @@ end;
If the mouse is on the top-left pixel of the container widget then the 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. coordinates can be negative, if there is frame around the client area.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function gtkMotionNotify(Widget:PGTKWidget; Event: PGDKEventMotion; procedure DeliverMouseMoveMessage(Widget:PGTKWidget; Event: PGDKEventMotion;
Data: gPointer): GBoolean; cdecl; AWinControl: TWinControl);
var var
Msg: TLMMouseMove; Msg: TLMMouseMove;
ShiftState: TShiftState; ShiftState: TShiftState;
MappedXY: TPoint; MappedXY: TPoint;
DesignOnlySignal: boolean;
begin 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, MappedXY:=TranslateGdkPointToClientArea(Event^.Window,
Point(trunc(Event^.X),trunc(Event^.Y)), Point(trunc(Event^.X),trunc(Event^.Y)),
PGtkWidget(TWinControl(Data).Handle)); PGtkWidget(AWinControl.Handle));
ShiftState := GTKEventState2ShiftState(Event^.State); ShiftState := GTKEventState2ShiftState(Event^.State);
with Msg do with Msg do
@ -592,8 +566,59 @@ begin
// send the message directly to the LCL // send the message directly to the LCL
// (Posting the message via queue // (Posting the message via queue
// has the risk of getting out of sync with the gtk) // has the risk of getting out of sync with the gtk)
DeliverMessage(Data, Msg); DeliverMessage(AWinControl, Msg);
//DeliverPostMessage(Data,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; end;
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
@ -616,17 +641,37 @@ begin
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'motion-notify-event'); gtk_signal_emit_stop_by_name(PGTKObject(Widget),'motion-notify-event');
CheckMouseCaptureHandle(Widget); CheckMouseCaptureHandle(Widget);
if (csDesigning in TComponent(Data).ComponentState) then exit;
if ControlGetsMouseMoveBefore(TControl(Data)) then exit;
DeliverMouseMoveMessage(Widget,Event,TWinControl(Data));
end; end;
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
gtkMouseBtnPress function ControlGetsMouseDownBefore(AControl: TControl): boolean;
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
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; function ControlGetsMouseDownBefore(AControl: TControl): boolean;
data: gPointer) : GBoolean; cdecl; 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 const
WHEEL_DELTA : array[Boolean] of Integer = (-1, 1); WHEEL_DELTA : array[Boolean] of Integer = (-1, 1);
var var
@ -635,7 +680,6 @@ var
ShiftState: TShiftState; ShiftState: TShiftState;
MappedXY: TPoint; MappedXY: TPoint;
EventXY: TPoint; EventXY: TPoint;
DesignOnlySignal: boolean;
{ $DEFINE VerboseMouseBugfix} { $DEFINE VerboseMouseBugfix}
@ -734,7 +778,7 @@ var
LastMouse.Window := Event^.Window; LastMouse.Window := Event^.Window;
LastMouse.WindowPoint := EventXY; LastMouse.WindowPoint := EventXY;
LastMouse.Down := True; LastMouse.Down := True;
LastMouse.Component:=TComponent(Data); LastMouse.Component:=AWinControl;
case LastMouse.ClickCount of case LastMouse.ClickCount of
1: MessI.Msg := MsgNormal; 1: MessI.Msg := MsgNormal;
@ -749,47 +793,10 @@ var
end; end;
begin 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)); EventXY:=Point(trunc(Event^.X),trunc(Event^.Y));
ShiftState := GTKEventState2ShiftState(Event^.State); ShiftState := GTKEventState2ShiftState(Event^.State);
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY, MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
PGtkWidget(TWinControl(Data).Handle)); PGtkWidget(AWinControl.Handle));
if event^.Button in [4,5] then begin if event^.Button in [4,5] then begin
// this is a mouse wheel event // this is a mouse wheel event
@ -798,14 +805,13 @@ begin
MessE.X := MappedXY.X; MessE.X := MappedXY.X;
MessE.Y := MappedXY.Y; MessE.Y := MappedXY.Y;
MessE.State := ShiftState; MessE.State := ShiftState;
MessE.UserData := Data; MessE.UserData := AWinControl;
MessE.Button := 0; MessE.Button := 0;
// send the message directly to the LCL // send the message directly to the LCL
// (Posting the message via queue // (Posting the message via queue
// has the risk of getting out of sync with the gtk) // has the risk of getting out of sync with the gtk)
//DeliverPostMessage(Data, MessE); DeliverMessage(AWinControl, MessE);
DeliverMessage(Data, MessE);
end end
else begin else begin
// a normal mouse button is pressed // a normal mouse button is pressed
@ -847,11 +853,63 @@ begin
// send the message directly to the LCL // send the message directly to the LCL
// (Posting the message via queue // (Posting the message via queue
// has the risk of getting out of sync with the gtk) // has the risk of getting out of sync with the gtk)
//DeliverPostMessage(Data, MessI); DeliverMessage(AWinControl, MessI);
DeliverMessage(Data, MessI);
end; end;
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 gtkMouseBtnPressAfter
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
@ -871,26 +929,45 @@ begin
' ',Trunc(Event^.X),',',Trunc(Event^.Y));} ' ',Trunc(Event^.X),',',Trunc(Event^.Y));}
{$ENDIF} {$ENDIF}
CheckMouseCaptureHandle(Widget);
// stop the signal, so that it is not sent to the parent widgets // stop the signal, so that it is not sent to the parent widgets
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-press-event'); 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; end;
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
gtkMouseBtnRelease function ControlGetsMouseUpBefore(AControl: TControl): boolean;
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
Returns: GBoolean
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; function ControlGetsMouseUpBefore(AControl: TControl): boolean;
data: gPointer) : GBoolean; cdecl; 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 var
MessI : TLMMouse; MessI : TLMMouse;
ShiftState: TShiftState; ShiftState: TShiftState;
MappedXY: TPoint; MappedXY: TPoint;
DesignOnlySignal: boolean;
function CheckMouseButtonUp(var LastMouse: TLastMouseClick; function CheckMouseButtonUp(var LastMouse: TLastMouseClick;
MsgUp: longint): boolean; MsgUp: longint): boolean;
@ -901,37 +978,9 @@ var
end; end;
begin 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, MappedXY:=TranslateGdkPointToClientArea(Event^.Window,
Point(trunc(Event^.X),trunc(Event^.Y)), Point(trunc(Event^.X),trunc(Event^.Y)),
PGtkWidget(TWinControl(Data).Handle)); PGtkWidget(AWinControl.Handle));
case event^.Button of case event^.Button of
@ -966,12 +1015,53 @@ begin
// send the message directly to the LCL // send the message directly to the LCL
// (Posting the message via queue // (Posting the message via queue
// has the risk of getting out of sync with the gtk) // has the risk of getting out of sync with the gtk)
//DeliverPostMessage(Data, MessI);
MessI.Result := 0; MessI.Result := 0;
DeliverMessage(Data, MessI); DeliverMessage(AWinControl, MessI);
end; end;
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 gtkMouseBtnReleaseAfter
Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
@ -994,8 +1084,15 @@ begin
gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-release-event'); gtk_signal_emit_stop_by_name(PGTKObject(Widget),'button-release-event');
CheckMouseCaptureHandle(Widget); CheckMouseCaptureHandle(Widget);
if (csDesigning in TComponent(Data).ComponentState) then exit;
if ControlGetsMouseUpBefore(TControl(Data)) then exit;
DeliverMouseUpMessage(Widget,Event,TWinControl(Data));
end; end;
function gtkclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; function gtkclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var var
Mess : TLMessage; Mess : TLMessage;
@ -2255,6 +2352,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.127 2002/09/10 06:49:19 lazarus
MG: scrollingwincontrol from Andrew MG: scrollingwincontrol from Andrew