paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-28 00:03:47 +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

9
lcl/include/popupmenu.inc
View File

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

3
lcl/menus.pp
View File

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