Add a PopupMenu to a custom component?

Hi Experts,

I am working on a strings logging component (derived from TListBox) and want it to have an embedded popup menu with options 'Select All', 'Cut',  'Copy', etc. (like TMemo has). Example of my (non-working)  code is below.

Q. How to add a popup menu to the component correctly?

Sincerely,
odissey1
unit FastLog;
 
interface
 
uses
  SysUtils, Classes, Controls, StdCtrls, Windows, Menus;
 
type
    TFastLog = class(TListBox)
    private
      { Private declarations }
      PopupMenu1: TPopupMenu;
      PopupMenu1SelectAll: TMenuItem;
    protected
      { Protected declarations }
    public
      { Public declarations }
      constructor Create(AOwner : TComponent); override;
      destructor Destroy; override;
    published
       { Published declarations }
   end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('MyComponent', [TFastLog]);
end;
 
constructor TFastLog.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
 
     PopupMenu1:=TPopupMenu.Create(self);
     PopupMenu1SelectAll:=TMenuItem.Create(self);
     PopupMenu1SelectAll.Caption:='Select All';
     PopupMenu1.Items.Add(PopupMenu1SelectAll);
 
     PopupMenu:=PopupMenu1;
 
end;
 
 
destructor TFastLog.Destroy;
begin
     PopupMenu1SelectAll.Free;
     PopupMenu1.Free;
 
     inherited;
end;
 
end.

Open in new window

LVL 2
odissey1Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ziolkoCommented:
code looks good but you need also add event handler
PopupMenu1SelectAll.OnClick := OnPopup;

TFastLog = class(TListBox)
    private
      { Private declarations }
      PopupMenu1: TPopupMenu;
      PopupMenu1SelectAll: TMenuItem;
      procedure OnPopup(Sender: TObject);

...

procedure TFastLog.OnPopup(Sender: TObject);
begin
  ShowMEssage('hello world');
end;

ziolko.
0
ziolkoCommented:
simple demo:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyListBox = class(TListBox)
  private
    FPopup: TPopupMenu;
    FPopupItem: TMenuItem;
    procedure OnPopup(Sender: TObject);
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy;override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var lb: TMyListBox;
begin
  lb := TMyListBox.Create(nil);
  lb.Parent := Self;
end;

{ TMyListBox }

constructor TMyListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPopup := TPopupMenu.Create(Self);
  FPopupItem := TMenuItem.Create(FPopup);
  FPopupItem.Caption := 'hello world';
  FPopupItem.OnClick := OnPopup;
  FPopup.Items.Add(FPopupItem);
  PopupMenu := FPopup;
end;

destructor TMyListBox.Destroy;
begin
  FPopup.Free;
  inherited Destroy;
end;

procedure TMyListBox.OnPopup(Sender: TObject);
begin
  ShowMessage('hello world');
end;

end.

ziolko.
0
odissey1Author Commented:
Hi,

The code (see below) work OK. Problem is in Object inspector in the PopupMenu field there is strange item:
'FastLog1.'
This field should be empty.

odissey1

unit FastLog;
 
interface
 
uses
  SysUtils, Classes, Controls, StdCtrls, Windows, Menus;
 
type
    TFastLog = class(TListBox)
    private
      { Private declarations }
 
      PopupMenu1: TPopupMenu;
      PopupMenu1Copy: TMenuItem;
      PopupMenu1Separator1: TMenuItem;
      PopupMenu1SelectAll: TMenuItem;
 
      procedure PopupMenu1Popup(Sender: TObject);
      procedure PopupMenu1SelectAllClick(Sender: TObject);
      procedure PopupMenu1CopyClick(Sender: TObject);
    protected
      { Protected declarations }
    public
      { Public declarations }
      constructor Create(AOwner : TComponent); override;
      destructor Destroy; override;
    published
       { Published declarations }
   end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('MyComponent', [TFastLog]);
end;
 
procedure TFastLog.PopupMenu1Popup(Sender: TObject);
begin
     PopupMenu1Copy.Enabled     :=(SelCount>0);
     PopupMenu1SelectAll.Enabled:=(SelCount<Count) ;
end;
procedure TFastLog.PopupMenu1CopyClick(Sender: TObject);
begin
     ...
end;
procedure TFastLog.PopupMenu1SelectAllClick(Sender: TObject);
begin
     ...
end;
 
constructor TFastLog.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
 
     PopupMenu1:=TPopupMenu.Create(self);
     PopupMenu1.OnPopup:=PopupMenu1Popup;
 
     PopupMenu1Copy:=TMenuItem.Create(Self);
     PopupMenu1Copy.Caption:='Copy';
     PopupMenu1Copy.OnClick := PopupMenu1CopyClick;
 
     PopupMenu1Separator1:=TMenuItem.Create(Self);
     PopupMenu1Separator1.Caption:='-';
 
     PopupMenu1SelectAll:=TMenuItem.Create(Self);
     PopupMenu1SelectAll.Caption:='Select All';
     PopupMenu1SelectAll.OnClick := PopupMenu1SelectAllClick;
 
     PopupMenu1.Items.Add(PopupMenu1Copy);
     PopupMenu1.Items.Add(PopupMenu1Separator1);
     PopupMenu1.Items.Add(PopupMenu1SelectAll);
 
     PopupMenu:=PopupMenu1; //<-is this correct?
end;
 
destructor TFastLog.Destroy;
begin
     PopupMenu1Copy.Free; //<-do we need al of this?
     PopupMenu1Separator1.Free;
     PopupMenu1SelectAll.Free;
     PopupMenu1.Free;
 
     inherited;
end;
 
end.

Open in new window

0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

ziolkoCommented:
>>This field should be empty.


nope, this fields shows name of popup menu assigned

>>PopupMenu:=PopupMenu1; //<-is this correct?
yes

>>PopupMenu1Copy.Free; //<-do we need al of this?
     PopupMenu1Separator1.Free;
     PopupMenu1SelectAll.Free;
     PopupMenu1.Free;


depends on how those objects were created, in your case - no. but it's good practice to destroy all created objects

if you create component like this comp := TSomeComponent.Create(OtherComponent);
then when OtherCOmponent will be destroyed it will also destroy >>comp<<
if you create >>comp<< like this:
comp := TSomeComponent.Create(nil);
then you are responsible for destroying >>comp<<

ziolko.
0
odissey1Author Commented:
Hi,
>>This field should be empty.
>>-nope, this fields shows name of popup menu assigned

When I drop TMemo on a form, the Object inspector field PopupMenu is empty. When I drop my TFastLog component, PopupMenu field has a [+] button and a name 'FastLog1.'. What is that? How get rid of it? I want it to be as in TMemo (empty).

odissey1


0
odissey1Author Commented:
continued..
Should we add something like
...
    published
       { Published declarations }
      property PopupMenu:TPopupMenu read GetPopupMenu write SetPopupMenu default ... ;
...

sorry for naivette...
odissey1
0
ziolkoCommented:
PopupMenu in object inspector is not empty because you've assigned PopupMenu in your constructor (PopupMenu:=PopupMenu1;), if you want it to be blank and still have popup working you must remove PopupMenu:=PopupMenu1; from constructor and activate popup "manually" (PopupMenu1.Popup()) when right mouse button is clicked on your component, but you must take care of situation when someone using your component will assign his own popup menu in object inspector.

eventually you can descend from TCustomListBox and don't publish PopupMenu property, this way it will not show PopupMenu in object inspector at all

ziolko.
0
odissey1Author Commented:
to ziolko:

can you give an example of how to catch a mouse click and popup "manually"?
(I will increase points..)

odissey1
0
ziolkoCommented:
 TMyListBox = class(TListBox)
  private
    FPopup: TPopupMenu;
    FPopupItem: TMenuItem;
    procedure OnPopup(Sender: TObject);
  protected
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy;override;
  end;


constructor TMyListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPopup := TPopupMenu.Create(Self);
  FPopupItem := TMenuItem.Create(FPopup);
  FPopupItem.Caption := 'hello world';
  FPopupItem.OnClick := OnPopup;
  FPopup.Items.Add(FPopupItem);
end;

destructor TMyListBox.Destroy;
begin
  FPopup.Free;
  inherited Destroy;
end;

procedure TMyListBox.OnPopup(Sender: TObject);
begin
  ShowMessage('hello world');
end;

procedure TMyListBox.WMRButtonDown(var Message: TWMRButtonDown);
var p: TPoint;
begin
  p := ClientToScreen(Point(Message.XPos, Message.YPos));
  inherited;
  FPopup.Popup(p.X, p.Y);
end;


ziolko.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
odissey1Author Commented:
to ziolko:

I modified to allow override embedded PopupMenu with user's custom PopupMenu as:
 
procedure TFastLog.WMRButtonDown(var Message: TWMRButtonDown);
var p: TPoint;
begin
  inherited;
  if not Assigned(PopupMenu) then begin
    p := ClientToScreen(Point(Message.XPos, Message.YPos));
    FPopupMenu.Popup(p.X, p.Y);
  end;
end;

Seems to work OK. If there is no objection I will close the thread (points increased).
odissey1
0
ziolkoCommented:
surelly no objection from me:)

ziolko.
0
ziolkoCommented:
ooops don;t know how it happened but i missed that post:

  published
       { Published declarations }
      property PopupMenu:TPopupMenu read GetPopupMenu write SetPopupMenu default ... ;


if you descend from TListBox you don't need that if from TCustomListBox
all you need is:

published
  property PopupMenu;

ziolko.
0
odissey1Author Commented:
Thank ypu for support,
odissey1

Final code
unit FastLog;
 
interface
 
uses
  SysUtils, Classes, Controls, StdCtrls, Windows, Menus, Messages;
 
type
    TFastLog = class(TListBox)
    private
      { Private declarations }
 
      FPopupMenu: TPopupMenu;
      FPopupMenuCopy: TMenuItem;
      FPopupMenuSeparator1: TMenuItem;
      FPopupMenuSelectAll: TMenuItem;
      procedure PopupMenuPopup(Sender: TObject);
      procedure PopupMenuSelectAllClick(Sender: TObject);
      procedure PopupMenuCopyClick(Sender: TObject);
    protected
      { Protected declarations }
      procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    public
      { Public declarations }
      constructor Create(AOwner : TComponent); override;
      destructor Destroy; override;
    published
       { Published declarations }
   end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('MyComponent', [TFastLog]);
end;
 
constructor TFastLog.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
 
     FPopupMenu:=TPopupMenu.Create(self);
 
     FPopupMenuCopy:=TMenuItem.Create(FPopupMenu);
     FPopupMenuCopy.Caption:='Copy';
     FPopupMenuCopy.OnClick := PopupMenuCopyClick;
 
     FPopupMenuSeparator1:=TMenuItem.Create(FPopupMenu);
     FPopupMenuSeparator1.Caption:='-';
 
     FPopupMenuSelectAll:=TMenuItem.Create(FPopupMenu);
     FPopupMenuSelectAll.Caption:='Select All';
     FPopupMenuSelectAll.OnClick := PopupMenuSelectAllClick;
 
     FPopupMenu.Items.Add(FPopupMenuCopy);
     FPopupMenu.Items.Add(FPopupMenuSeparator1);
     FPopupMenu.Items.Add(FPopupMenuSelectAll);
 
     FPopupMenu.OnPopup:=PopupMenuPopup;
end;
 
destructor TFastLog.Destroy;
begin
     FPopupMenu.Free;
     inherited;
end;
 
procedure TFastLog.WMRButtonDown(var Message: TWMRButtonDown);
var p: TPoint;
begin
     inherited;
     if not Assigned(PopupMenu) then begin
       p := ClientToScreen(Point(Message.XPos, Message.YPos));
       FPopupMenu.Popup(p.X, p.Y);
     end;
end;
 
procedure TFastLog.PopupMenuPopup(Sender: TObject);
begin
     FPopupMenuCopy.Enabled  :=(SelCount>0);
     FPopupMenuSelectAll.Enabled:=(SelCount<Count) ;
end;
 
procedure TFastLog.PopupMenuCopyClick(Sender: TObject);
begin
...
end;
 
procedure TFastLog.PopupMenuSelectAllClick(Sender: TObject);
begin
...
end;
 
end.

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.