¿Cómo hacer un menú emergente con la barra de desplazamiento?

Question

Utilizo TPopupMenu en mi programa, me gustaría agregar una barra de desplazamiento vertical en él y poder establecer su tamaño (digamos 10 elementos visibles), y manejar los eventos moviendo la barra de desplazamiento del control deslizante (después de hacer clic en los botones, o después desplazando la rueda del mouse). Me gustaría saber si los componentes con este funcional existen, o me complacerá la teoría sobre la creación de este componente. Por ejemplo, necesito un comportamiento similar al menú emergente en la barra de direcciones del Explorador de Vista/7 (con una lista de subcarpetas en la carpeta actual)

Gracias.

Answer 1

Actualización:

El código siguiente muestra cómo extender un menú emergente estándar para mostrar su propia forma emergente en lugar de un verdadero menú. Los elementos del menú se representan en el cuadro de lista con el DrawMenuItem lo que respeta también el dibujo personalizado de los elementos (si hay alguno). También la medición de la altura del artículo se toma en una cuenta para que las alturas del artículo sean las mismas que si se usara un menú estándar. Las siguientes propiedades se ha introducido para el control TPopupMenu:

• PopupForm - es la propiedad obligatorio que tiene que ser establecido cuando se utiliza el modo personalizado y es la forma que tiene que mantener la atención cuando ejecutar el menú
• PopupMode - es el cambio entre modo normal y especial (predeterminado es pmStandard)
  - pmCustom - usará un formulario personalizado en lugar de un menú emergente estándar
  - pmStandard - usará un menú emergente estándar e ignorará todas las propiedades nuevas
• PopupCount: es el recuento de los elementos que se mostrarán cuando aparece el menú, tiene el mismo significado que el DropDownCount en el cuadro combinado (por defecto es 5)

cómo extender el control del menú emergente:

Crear una forma vacía y el nombre como TPopupForm, la unidad de guardar como PopupUnit y copiar, pegar el siguiente código y guardarlo de nuevo:

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. 

Cómo utilizar que el control de menú emergente extendida:

Simplemente agregue el PopupUnit al final de su uses cláusula y los controles del menú emergente obtendrán las nuevas propiedades.

Si desea utilizar el modo con el formulario personalizado en lugar del verdadero menú, utilice el siguiente antes de que el menú emergente:

// 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; 

Si desea utilizar el menú emergente clásico de dejar las cosas como estaban ya el modo estándar es por defecto o simplemente ajustar el modo de esta manera y se mostrará el menú emergente estándar (el resto de las nuevas propiedades se ignora en este caso):

PopupMenu1.PopupMode := pmStandard; 

responsabilidad:

El código necesita una revisión (al menos falta la implementación de los atajos de menú) y algunas partes deberían mejorarse.