How to make a popup menu with scrollbar?

Question

I use TPopupMenu in my program, I would like to add a vertical scrollbar in it and be able to set its size (say 10 visible items), and handle the events moving the slider scrollbar (after clicking on the buttons, or after scrolling the mouse wheel). I would like to know the components with this functional exist, or I will be glad of the theory about creating this component. For example, I need behavior similar to popup menu in Vista/7 Explorer's address bar (with a list of subfolders in current folder)

Thanks.

Answer 1

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.