How to create a scroll list popup menu?

Question

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

Thanks.

Answer 1

Update:

The following code shows how to extend the standard popup menu to show your own popup instead of the real menu. Menu items are displayed in the list box using DrawMenuItem , which also applies to custom drawing of items (if any). Also, the measurement of the height of the position is taken into the account, so the height of the element should be the same as if you used the standard menu. The following properties were introduced in the TPopupMenu control:

• PopupForm is a required property that must be set when using user mode, and it is a form that should maintain focus when a menu appears
• PopupMode is a switch between normal and special modes (default is pmStandard)
  - pmCustom - will use a custom form instead of the standard popup menu
  - pmStandard - will use the standard popup menu and ignore all new properties
• PopupCount - this is a count of elements that will be displayed when the menu appears, has a value similar to DropDownCount in the combo box (default is 5)

How to extend a popup menu control:

Create an empty form and name it as TPopupForm , save the block 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 the advanced pop-up menu:

Just add PopupUnit to the end of your uses , and the context menu items will get new properties.

If you want to use the mode with a custom form instead of the real menu, use the following before the popup menu:

 // 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 the classic pop-up menu, leave the settings as they were from the standard mode by default, or simply set this mode in such a way and the standard pop-up menu will appear (in this case, the rest of the other properties are ignored)

 PopupMenu1.PopupMode := pmStandard; 

Denial of responsibility:

The code needs to be reviewed (at least there is no implementation of menu shortcuts at all), and some parts need to be improved.