NevTon
NevTon

Reputation: 289

TPopupMenu subclassing inside a package breaks IDE's popup menus handling after installing

I'm making a component where I need to handle custom painting of a TPopupMenu class, especially including non-client area of a popup window. So, I did some subclassing as recommended on the internet. But with one difference, my subclass source unit is inside a package. And while testing I discovered that immediatly after installing this package, my IDE's popup menus stop working, they are showing and looking ok, but not all commands now make what they suppose to do. Most of them do nothing at all after clicking on them. Can anybody check if my discovery is right or maybe my code is somehow wrong, but I don't think so, because it is very simple test case. I've checked this behavior under Delphi 2010 and 10.3.3. Both do the same in my test.

Thank You.

Test code (remember to put it in a package, and just install this package into Delphi IDE):

unit uPopupListSubclass;

interface

implementation

uses
  SysUtils,
  Classes,
  Messages,
  Windows,
  Menus;

type
  TPopupListEx = class(TPopupList)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

{ TPopupListEx }

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
  inherited;
end;

initialization
  PopupList.Free;
  PopupList := TPopupListEx.Create;

end.

IMPORTANT INFO:
To remove this package You must go to menu: Component -> Install Packages... -> uncheck component -> click Remove button -> click OK button -> restart IDE.

Your IDE might make some AV's along the way uninstalling this package (sorry). But after restart it should work fine, as before.

EDIT:
EDIT2:
Modified source to avoid AV's during removal/disabling of a package.
Added delegation to original popup list.

type
  TPopupListAccess = class(TPopupList);

var
  OriginalPopupList: TPopupList;

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
  TPopupListAccess(OriginalPopupList).WndProc(Message);
  inherited;
end;

initialization
  OriginalPopupList := PopupList;
  PopupList := TPopupListEx.Create;

finalization
  PopupList.Free;
  PopupList := OriginalPopupList;

Upvotes: 0

Views: 126

Answers (1)

SilverWarior
SilverWarior

Reputation: 8396

You are not subclassing the TPoputList correctly. In fact you are not subclassing the TPopupList at all but replacing it.

PopupList is a global variable declared in VCL.Menus unit. So when you call PopupList.Free in your initialization section you are destrooying the original PopupList interface that was created in VCL.Menus unit. This is what breaks all PopupMenu's of the whole IDE.

You should never free an object that you did not create yourself.
Doing so you are interfering and possibly breaking the original code that works with that object.
You should only free objects that you have created yourself.

Instead what you should od is create your own PopupListEx global variable and reference to if from the code in your package instead to original PopupList variable.

EDIT: You are lucky that you haven't crashed te IDE entirely with your code as it is interfering with existing IDE code.

Upvotes: 3

Related Questions