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

lcl: protect TTrayIcon code from the PopupMenu component destruction

Browse Source 
git-svn-id: trunk@21846 -
This commit is contained in:
paul 2009-09-24 09:29:27 +00:00
parent e8e52a07ea
commit 42ad042ae5
2 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/extctrls.pp
View File

@ -1170,12 +1170,14 @@ type
function GetCanvas: TCanvas; function GetCanvas: TCanvas;
procedure SetHint(const AValue: string); procedure SetHint(const AValue: string);
procedure SetIcon(const AValue: TIcon); procedure SetIcon(const AValue: TIcon);
procedure SetPopUpMenu(const AValue: TPopupMenu);
procedure SetVisible(Value: Boolean); procedure SetVisible(Value: Boolean);
procedure HandleNotifierClose(Sender: TObject; var CloseAction: TCloseAction); procedure HandleNotifierClose(Sender: TObject; var CloseAction: TCloseAction);
procedure HandleNotifierTimeout(Sender: TObject); procedure HandleNotifierTimeout(Sender: TObject);
procedure IconChanged(Sender: TObject); procedure IconChanged(Sender: TObject);
protected protected
class procedure WSRegisterClass; override; class procedure WSRegisterClass; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public public
Handle: PtrInt; Handle: PtrInt;
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
@ -1191,7 +1193,7 @@ type
property BalloonTimeout: Integer read FBalloonTimeout write FBalloonTimeout default 3000; property BalloonTimeout: Integer read FBalloonTimeout write FBalloonTimeout default 3000;
property BalloonTitle: string read FBalloonTitle write FBalloonTitle; property BalloonTitle: string read FBalloonTitle write FBalloonTitle;
property Canvas: TCanvas read GetCanvas; property Canvas: TCanvas read GetCanvas;
property PopUpMenu: TPopupMenu read FPopUpMenu write FPopUpMenu; property PopUpMenu: TPopupMenu read FPopUpMenu write SetPopUpMenu;
property Icon: TIcon read FIcon write SetIcon; property Icon: TIcon read FIcon write SetIcon;
property Hint: string read FHint write SetHint; property Hint: string read FHint write SetHint;
property ShowIcon: Boolean read FShowIcon write FShowIcon default True; property ShowIcon: Boolean read FShowIcon write FShowIcon default True;

17
lcl/include/customtrayicon.inc
View File

@ -173,6 +173,14 @@ begin
RegisterCustomTrayIcon; RegisterCustomTrayIcon;
end; end;
procedure TCustomTrayIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FPopUpMenu) then
PopupMenu := nil;
end;
{******************************************************************* {*******************************************************************
* TCustomTrayIcon.InternalUpdate () * TCustomTrayIcon.InternalUpdate ()
* *
@ -267,4 +275,13 @@ begin
FIcon.Assign(AValue); FIcon.Assign(AValue);
end; end;
procedure TCustomTrayIcon.SetPopUpMenu(const AValue: TPopupMenu);
begin
if FPopUpMenu = AValue then
Exit;
FPopupMenu := AValue;
if FPopupMenu <> nil then
FPopUpMenu.FreeNotification(Self);
end;
// included by extctrls.pp // included by extctrls.pp