paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 18:37:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/PopupMenu: Make TPopupMenu.PopupPoint a writable property.

Browse Source
This commit is contained in:
wp_xyz 2024-07-27 12:12:18 +02:00
parent 00f3d3b397
commit 987f140c91
2 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/include/popupmenu.inc
View File

@ -69,7 +69,7 @@ end;
procedure TPopupMenu.PopUp(X, Y: Integer);
begin
if ActivePopupMenu <> nil then ActivePopupMenu.Close;
FPopupPoint := Point(X, Y);
SetPopupPoint(Point(X, Y));
ReleaseCapture;
DoPopup(Self);
if Items.Count = 0 then exit;
@ -78,7 +78,12 @@ begin
DestroyHandle;
CreateHandle;
if Assigned(OnMenuPopupHandler) then OnMenuPopupHandler(Self);
TWSPopupMenuClass(WidgetSetClass).Popup(Self, X, Y);
TWSPopupMenuClass(WidgetSetClass).Popup(Self, FPopupPoint.X, FPopupPoint.Y);
end;
procedure TPopupMenu.SetPopupPoint(APopupPoint: TPoint);
begin
FPopupPoint := APopupPoint;
end;
procedure TPopupMenu.Close;

3
lcl/menus.pp
View File

@ -464,13 +464,14 @@ type
class procedure WSRegisterClass; override;
procedure DoPopup(Sender: TObject); virtual;
procedure DoClose; virtual;
procedure SetPopupPoint(APopupPoint: TPoint);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure PopUp;
procedure PopUp(X, Y: Integer); virtual;
property PopupComponent: TComponent read FPopupComponent write FPopupComponent;
property PopupPoint: TPoint read FPopupPoint;
property PopupPoint: TPoint read FPopupPoint write SetPopupPoint;
procedure Close;
published
property Alignment: TPopupAlignment read FAlignment write FAlignment default paLeft;