7

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.

TLama
  • 75,147
  • 17
  • 214
  • 392
ibogolyubskiy
  • 2,271
  • 3
  • 26
  • 52
  • See http://stackoverflow.com/questions/6203217/is-there-an-edit-control-for-delphi-that-allows-path-editing – Sertac Akyuz Jun 08 '12 at 11:23
  • OK, I viewed the components in this topic, but all of them use standart TPopupMenu to show subfolders list. Standard TPopupMenu with a large number of items extends the full height of the screen, and when it becomes low, the arrows become visible on the top and bottom of the menu, and if you click on them, the menu scrolls up or down. This behavior does not suit me. I want to scroll the menu by vertical scrollbar. Is it possible? – ibogolyubskiy Jun 08 '12 at 11:56
  • I don't think so, I think explorer does not use a menu at all with the breadcrumb, though I'm not really sure. – Sertac Akyuz Jun 08 '12 at 12:03
  • Maybe there is a component that looks like a standard TPopupMenu, but it has a property such as DropDownCount (like ComboBox), and when the number of menu items more than the property ScrollBar become visible, and it can be used to scroll the menu to see all menu items – ibogolyubskiy Jun 08 '12 at 12:12
  • 2
    You don't want a menu here. What you describe is a combo box. That's what explorer is using. – David Heffernan Jun 08 '12 at 13:01
  • @David - It behaves different than a combo's dropped down list box in that it doesn't eat a left button click when you click at the outside. (That doesn't mean it's definitely not a combo of course...) – Sertac Akyuz Jun 08 '12 at 13:10
  • @David, the Explorer address control in Windows 7 (and Vista, I assume) is a combination of several controls. Normally, it's a "Breadcrumb Parent" with a toolbar inside it. Each toolbar button displays a menu. If you click outside the button area, the toolbar disappears and a sibling combo box appears in its place. The drop-down and refresh buttons on the right are on a separate toolbar, sibling to the breadcrumb parent and the combo box. I don't know how to find out whether the menu is a standard Windows menu, but I see no reason to assume it *isn't* that. – Rob Kennedy Jun 08 '12 at 15:01
  • I see what you all mean now. I have to say I don't tend to use the breadcrumb menus. I tend to use that control as an edit and I think it does auto complete if memory serves. – David Heffernan Jun 08 '12 at 16:21
  • Was curious.. The dropdown of a breadcrumb is a window of class *'DropDown'*, in it, there's a window of class *'ListviewPopup'*. There are also some *'SysListView32'*s and *'SysHeader32*'s. – Sertac Akyuz Jun 08 '12 at 18:52
  • @Sertac, I would tend to use a *popup list box*. I feel like this question asks more for a popup menu with scrollbars than a breadcrumb bar popup control with its content. – TLama Jun 08 '12 at 19:01
  • 1
    @TLama - Having fiddled in the past few hours sizing a #32768 (popup) and setting 'WS_VSCROLL' on it, and realizing the work required to make the scrollbar come alive (and then possibly fail), I tend to agree with you. In fact I'll upvote your answer... – Sertac Akyuz Jun 08 '12 at 19:12
  • @Sertac, thanks, but originally I was thinking about to make that post as a community wiki since there's nothing more than `DrawMenuItem` usage shown. Now you forced me to finish that (when I get to Delphi). – TLama Jun 08 '12 at 19:17
  • 1
    @TLama - Heh, I can't upvote any more.. :) Seriously, I'm sure there are a few questions on SO that asks how to make a popdown-form or such. Don't feel obliged.. – Sertac Akyuz Jun 08 '12 at 19:20

1 Answers1

12

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.

TLama
  • 75,147
  • 17
  • 214
  • 392
  • This is great, but unfortunately I can't use it because it doesn't show sub-menus. I don't suppose you could add support for that, could you? – matthewk Jan 05 '17 at 17:57
  • Two comments: you can simplify your code by getting rid of FPopupForm in both TPopupMenu and TPopupForm. And the "FListBox.ItemHeight := ItemHeight;" statement is useless for a lbOwnerDrawVariable listbox. – Emmanuel Ichbiah Nov 23 '22 at 11:15