Update:
The following code shows how to extend a standard popup menu to show your own popup form instead of a real menu. The menu items are rendered into list box with the DrawMenuItem what respects also custom drawing of the items (if there is some). Also item height measurement is taken into an account so the item heights should be the same as if you would use a standard menu. The following properties has been introduced to the TPopupMenu control:
- PopupForm - is the mandatory property that has to be set when you use the custom mode and it's the form which needs to keep focus when you popup the menu
- PopupMode - it is the switch between normal and special mode (default is pmStandard)
- pmCustom - will use a custom form instead of a standard popup menu
- pmStandard - will use a standard popup menu and ignore all the new properties
- PopupCount - is the count of the items to be displayed when the menu pops up, it has the similar meaning as the DropDownCount at combo box (default is 5)
How to extend the popup menu control:
Create an empty form and name it as TPopupForm, the unit save as PopupUnit and copy, paste the following code and save it again:
unit PopupUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TPopupMode = (pmStandard, pmCustom);
TPopupMenu = class(Menus.TPopupMenu)
private
FPopupForm: TForm;
FPopupMode: TPopupMode;
FPopupCount: Integer;
public
constructor Create(AOwner: TComponent); override;
procedure Popup(X, Y: Integer); override;
property PopupForm: TForm read FPopupForm write FPopupForm;
property PopupMode: TPopupMode read FPopupMode write FPopupMode;
property PopupCount: Integer read FPopupCount write FPopupCount;
end;
type
TMenuItem = class(Menus.TMenuItem)
end;
TPopupForm = class(TForm)
private
FListBox: TListBox;
FPopupForm: TForm;
FPopupMenu: TPopupMenu;
FPopupCount: Integer;
procedure WMActivate(var AMessage: TWMActivate); message WM_ACTIVATE;
procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ListBoxMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure ListBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ListBoxKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
protected
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent; APopupForm: TForm;
APopupMenu: TPopupMenu; APopupCount: Integer); reintroduce;
end;
var
PopupForm: TPopupForm;
implementation
{$R *.dfm}
{ TPopupForm }
constructor TPopupForm.Create(AOwner: TComponent; APopupForm: TForm;
APopupMenu: TPopupMenu; APopupCount: Integer);
var
I: Integer;
MaxWidth: Integer;
MaxHeight: Integer;
ItemWidth: Integer;
ItemHeight: Integer;
begin
inherited Create(AOwner);
BorderStyle := bsNone;
FPopupForm := APopupForm;
FPopupMenu := APopupMenu;
FPopupCount := APopupCount;
FListBox := TListBox.Create(Self);
FListBox.Parent := Self;
FListBox.BorderStyle := bsNone;
FListBox.Style := lbOwnerDrawVariable;
FListBox.Color := clMenu;
FListBox.Top := 2;
FListBox.Left := 2;
MaxWidth := 0;
MaxHeight := 0;
FListBox.Items.BeginUpdate;
try
FListBox.Items.Clear;
for I := 0 to FPopupMenu.Items.Count - 1 do
begin
TMenuItem(FPopupMenu.Items[I]).MeasureItem(FListBox.Canvas, ItemWidth,
ItemHeight);
if ItemWidth > MaxWidth then
MaxWidth := ItemWidth;
if I < FPopupCount then
MaxHeight := MaxHeight + ItemHeight;
FListBox.Items.Add('');
end;
finally
FListBox.Items.EndUpdate;
end;
if FPopupMenu.Items.Count > FPopupCount then
MaxWidth := MaxWidth + GetSystemMetrics(SM_CXVSCROLL) + 16;
FListBox.Width := MaxWidth;
FListBox.Height := MaxHeight;
FListBox.ItemHeight := ItemHeight;
FListBox.OnMouseDown := ListBoxMouseDown;
FListBox.OnMouseUp := ListBoxMouseUp;
FListBox.OnDrawItem := ListBoxDrawItem;
FListBox.OnKeyDown := ListBoxKeyDown;
FListBox.OnMeasureItem := ListBoxMeasureItem;
FListBox.OnMouseMove := ListBoxMouseMove;
ClientWidth := FListBox.Width + 4;
ClientHeight := FListBox.Height + 4;
end;
procedure TPopupForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;
procedure TPopupForm.ListBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
DrawMenuItem(FPopupMenu.Items[Index], FListBox.Canvas, Rect, State);
end;
procedure TPopupForm.ListBoxKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_ESCAPE: Close;
VK_RETURN:
begin
Close;
if FListBox.ItemIndex <> -1 then
FPopupMenu.Items[FListBox.ItemIndex].Click;
end;
end;
end;
procedure TPopupForm.ListBoxMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
var
ItemWidth: Integer;
begin
TMenuItem(FPopupMenu.Items[Index]).MeasureItem(FListBox.Canvas, ItemWidth,
Height);
end;
procedure TPopupForm.ListBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
SetCapture(FListBox.Handle);
end;
procedure TPopupForm.ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
ItemIndex: Integer;
begin
ItemIndex := FListBox.ItemAtPos(Point(X, Y), True);
if ItemIndex <> FListBox.ItemIndex then
FListBox.ItemIndex := ItemIndex;
end;
procedure TPopupForm.ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Close;
if FListBox.ItemIndex <> -1 then
FPopupMenu.Items[FListBox.ItemIndex].Click;
end;
procedure TPopupForm.Paint;
begin
inherited;
Canvas.Pen.Color := clSilver;
Canvas.Rectangle(ClientRect);
end;
procedure TPopupForm.WMActivate(var AMessage: TWMActivate);
begin
SendMessage(FPopupForm.Handle, WM_NCACTIVATE, 1, 0);
inherited;
if AMessage.Active = WA_INACTIVE then
Release;
end;
{ TPopupMenu }
constructor TPopupMenu.Create(AOwner: TComponent);
begin
inherited;
FPopupMode := pmStandard;
FPopupCount := 5;
end;
procedure TPopupMenu.Popup(X, Y: Integer);
begin
case FPopupMode of
pmCustom:
with TPopupForm.Create(nil, FPopupForm, Self, FPopupCount) do
begin
Top := Y;
Left := X;
Show;
end;
pmStandard: inherited;
end;
end;
end.
How to use that extended popup menu control:
Simply add the PopupUnit to the end of your uses clause and the popup menu controls will get the new properties.
If you want to use the mode with the custom form instead of real menu, use the following before the menu popup:
// this will enable the custom mode
PopupMenu1.PopupMode := pmCustom;
// this will fake the currently focused form as active, it is mandatory to
// assign the currently focused form to this property (at least now); so Self
// used here is the representation of the currently focused form
PopupMenu1.PopupForm := Self;
// this will show 5 menu items and the rest will be accessible by scroll bars
PopupMenu1.PopupCount := 5;
If you want to use classic popup menu leave the settings as they were since standard mode is default or simply set the mode this way and the standard popup menu will be shown (the rest of the new properties is ignored in this case):
PopupMenu1.PopupMode := pmStandard;
Disclaimer:
The code needs a review (at least there is missing menu shortcuts implementation at all) and some parts should be improved.
