以下代码显示如何扩展标准弹出菜单以显示您自己的弹出窗体而不是真实菜单.使用DrawMenuItem将菜单项渲染到列表框中,还考虑项目的自定义绘图(如果有的话).项目高度测量也会被记入一个帐户,因此项目高度应与使用标准菜单时相同. TPopupMenu控件引入了以下属性：

> PopupForm – 是使用自定义模式时必须设置的强制属性,它是弹出菜单时需要保持焦点的表单
> PopupMode – 它是正常模式和特殊模式之间的切换(默认是pmStandard) – pmCustom – 将使用自定义表单而不是标准弹出菜单 – pmStandard – 将使用标准弹出菜单并忽略所有新属性
> PopupCount – 弹出菜单时显示的项目数,它与组合框中的DropDownCount具有相似的含义(默认为5)

如何扩展弹出菜单控件：

创建一个空表单并将其命名为TPopupForm,该单元保存为PopupUnit并复制,粘贴以下代码并再次保存：

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,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.

如何使用扩展的弹出菜单控件：

只需将PopupUnit添加到uses子句的末尾,弹出菜单控件就会获得新属性.

如果要使用自定义窗体而不是真实菜单的模式,请在菜单弹出窗口之前使用以下命令：

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

如果您想使用经典弹出菜单,请保留设置,因为标准模式是默认设置或只是以这种方式设置模式,将显示标准弹出菜单(在这种情况下,其余的新属性将被忽略)：

PopupMenu1.PopupMode := pmStandard;

免责声明：

代码需要审查(至少缺少菜单快捷方式实现),并且应该改进一些部分.