paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 10:52:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'gtk1-fix-design-context-menu' into 'main'

Browse Source 
LCL-GTK1: Fix designer context menu

See merge request freepascal.org/lazarus/lazarus!237
This commit is contained in:
Maxim Ganetsky 2023-09-27 23:33:47 +00:00
commit e2f9f0c8ef
1 changed files with 52 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1548,7 +1548,7 @@ end;
-------------------------------------------------------------------------------}
function gtkMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton;
data: gPointer) : GBoolean; cdecl;
procedure CheckListSelection;
var
List: PGlist;
@ -1590,13 +1590,53 @@ var
DesignOnlySignal: boolean;
AWinControl: TWinControl;
{$IFDEF GTK1}
CaptureWidget, W: PGtkWidget;
EventXY: TPoint;
MappedXY, CursorPos: TPoint;
Info: PWidgetInfo;
Old: TObject;
Msg: TLMContextMenu;
CaptureWidget: PGtkWidget;
MappedXY, EventXY: TPoint;
{$ENDIF}
// Send LM_CONTEXTMENU to the first control that responds to it
function SendContextMenuMessage: Boolean;
var
CursorPos: TPoint;
Info: PWidgetInfo;
Old: TObject;
Msg: TLMContextMenu;
W: PGtkWidget;
begin
Result:=False;
W := Widget;
CursorPos := Mouse.CursorPos;
Old := nil;
while W <> nil do
begin
Info := GetWidgetInfo(W);
if (Info <> nil) and (Info^.LCLObject <> Old) then
begin
Old := Info^.LCLObject;
FillChar(Msg{%H-}, SizeOf(Msg), #0);
Msg.Msg := LM_CONTEXTMENU;
Msg.hWnd := {%H-}HWND(W);
Msg.XPos := CursorPos.X;
Msg.YPos := CursorPos.Y;
Result := DeliverMessage(Old, Msg) <> 0;
if Result then begin
g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
Break;
end;
end;
W := W^.parent;
end;
// how to skip default right click handling? LCL can tell only on mouse up
// if handling can be skiped but gtk needs on mouse down
if ((AWinControl.PopupMenu <> nil) or
(TWinControlAccess(Data).OnContextPopup <> nil)) then begin
if (TControl(Data) is TCustomTabControl) then
g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
Result := True;
end;
end;
begin
Result := CallBackDefaultReturn;
MousePositionValid := False;
@ -1643,38 +1683,7 @@ begin
end
else
if (Event^.button = 3) then begin
// Send LM_CONTEXTMENU to the first control that responds to it
W := Widget;
CursorPos := Mouse.CursorPos;
Old := nil;
while W <> nil do
begin
Info := GetWidgetInfo(W);
if (Info <> nil) and (Info^.LCLObject <> Old) then
begin
Old := Info^.LCLObject;
FillChar(Msg{%H-}, SizeOf(Msg), #0);
Msg.Msg := LM_CONTEXTMENU;
Msg.hWnd := {%H-}HWND(W);
Msg.XPos := CursorPos.X;
Msg.YPos := CursorPos.Y;
Result := DeliverMessage(Old, Msg) <> 0;
if Result then begin
g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
Break;
end;
end;
W := W^.parent;
end;
// how to skip default right click handling? LCL can tell only on mouse up
// if handling can be skiped but gtk needs on mouse down
if ((AWinControl.PopupMenu <> nil) or
(TWinControlAccess(Data).OnContextPopup <> nil)) then begin
if (TControl(Data) is TCustomTabControl) then
g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
Result := True;
end;
if SendContextMenuMessage then Result := True;
end;
end else begin
if (event^.Button=1) and (TControl(Data) is TCustomTabControl) then
@ -1682,6 +1691,10 @@ begin
// clicks on the notebook should be handled by the gtk (switching page)
end
else
if (Event^.button = 3) then begin
if SendContextMenuMessage then Result := True;
end
else
begin
// stop the signal, so that the widget does not auto react
//DebugLn(['gtkMouseBtnPress stop signal']);