We help IT Professionals succeed at work.

Add a PopupMenu to a custom component?

odissey1
odissey1 asked
on
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

Comment
Watch Question

Lukasz Zielinskisoftware developer
CERTIFIED EXPERT
Top Expert 2008

Commented:
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.
Lukasz Zielinskisoftware developer
CERTIFIED EXPERT
Top Expert 2008

Commented:
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.

Author

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

Lukasz Zielinskisoftware developer
CERTIFIED EXPERT
Top Expert 2008

Commented:
>>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.

Author

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


Author

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

sorry for naivette...
odissey1
Lukasz Zielinskisoftware developer
CERTIFIED EXPERT
Top Expert 2008

Commented:
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.

Author

Commented:
to ziolko:

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

odissey1
software developer
CERTIFIED EXPERT
Top Expert 2008
Commented:
 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.

Author

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
Lukasz Zielinskisoftware developer
CERTIFIED EXPERT
Top Expert 2008

Commented:
surelly no objection from me:)

ziolko.
Lukasz Zielinskisoftware developer
CERTIFIED EXPERT
Top Expert 2008

Commented:
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.

Author

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

Explore More ContentExplore courses, solutions, and other research materials related to this topic.