logo标签列表

如何制作带有滚动条的弹出菜单？

delphi
7
我在我的程序中使用了TPopupMenu，我想在其中添加一个垂直滚动条，并能够设置其大小（比如10个可见项），并处理移动滑块滚动条的事件（点击按钮后或滚动鼠标轮）。 我希望知道是否存在具有此功能的组件，如果没有，我将很高兴得到创建此组件的理论。例如，我需要类似于Vista / 7 Explorer地址栏中的弹出菜单（显示当前文件夹的子文件夹列表）的行为。
谢谢。
我不这么认为，我认为资源管理器在使用面包屑时根本不使用菜单，尽管我并不确定。 - Sertac Akyuz
也许有一个组件看起来像标准的TPopupMenu，但它有一个属性，比如DropDownCount（就像ComboBox），当菜单项数量超过ScrollBar变得可见时，可以使用它来滚动菜单以查看所有菜单项。 - ibogolyubskiy
2
你不想在这里使用菜单。你描述的是组合框。这就是资源管理器所使用的。 - David Heffernan
1
@TLama - 过去几个小时中，我一直在调整大小为 #32768（弹出）的窗口，并在其上设置“WS_VSCROLL”，意识到使滚动条生效（然后可能失败）所需的工作量，我倾向于同意您的观点。实际上，我会支持您的答案... - Sertac Akyuz
1
@TLama - 嘿，我不能再点赞了.. :) 说真的，我相信在SO上有一些问题问如何制作下拉表单或类似的东西。不要感到有义务.. - Sertac Akyuz
显示剩余8条评论
1个回答
12

更新：

以下代码展示了如何扩展标准弹出菜单，以显示您自己的弹出窗体而不是实际菜单。菜单项被呈现为带有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, 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.

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

只需将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;
免责声明:

该代码需要进行审查（至少所有菜单快捷方式的实现都已经丢失），并且有些部分应该得到改进。

这很棒，但不幸的是我不能使用它，因为它不显示子菜单。你能否添加支持呢？ - matthewk
两个注释：您可以通过在TPopupMenu和TPopupForm中摆脱FPopupForm来简化代码。而且对于lbOwnerDrawVariable列表框，“FListBox.ItemHeight := ItemHeight;”语句是无用的。 - Emmanuel Ichbiah
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接