如何使滚动条弹出菜单？ [英] How to make a popup menu with scrollbar?

问题描述

在我的程序中，我使用 TPopupMenu ，我想在其中添加一个垂直滚动条，并可以设置其大小（例如10个可见项），并处理事件移动滑块滚动条（点击按钮后，或滚动鼠标滚轮后）。我想知道这个功能存在的组件，否则我将很乐意创建这个组件的理论。
例如，我需要类似于Vista / 7 Explorer的地址栏中弹出菜单的行为（包含当前文件夹中的子文件夹列表）

谢谢。 p>

解决方案

更新：

以下代码显示了如何扩展标准弹出菜单以显示您自己的弹出窗体而不是真正的菜单。菜单项被渲染到具有 DrawMenuItem 的列表框中，什么也尊重项目的自定义绘图（如果有的话）。此外，物品高度测量也被纳入一个帐户，所以项目高度应该与使用标准菜单相同。以下属性已经被引入到 TPopupMenu 控件中：

• PopupForm - 是使用自定义模式时必须设置的强制属性，当弹出菜单时，需要保持焦点的形式


• PopupMode - 正常和特殊模式之间的切换（默认为pmStandard）
  - pmCustom - 将使用自定义表单而不是标准弹出菜单
  - pmStandard - 将使用标准弹出菜单并忽略所有新属性


• PopupCount - 当弹出菜单时要显示的项目的计数，它具有与组合框中的DropDownCount相同的含义（默认为5）

如何扩展弹出菜单控件：

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

单位PopupUnit

  ; 
 
接口
 
使用
 Windows，消息，SysUtils，变体，类，图形，控件，表单，
对话框，StdCtrls，菜单; 
 
 type 
 TPopupMode =（pmStandard，pmCustom）; 
 TPopupMenu = class（Menus.TPopupMenu）
 private 
 FPopupForm：TForm; 
 FPopupMode：TPopupMode; 
 FPopupCount：Integer; 
 public 
构造函数Create（AOwner：TComponent）;覆盖
 procedure Popup（X，Y：Integer）;覆盖
属性PopupForm：TForm读取FPopupForm写入FPopupForm; 
属性PopupMode：TPopupMode读取FPopupMode写FPopupMode; 
属性PopupCount：整数读取FPopupCount写入FPopupCount; 
结束
 
 type 
 TMenuItem = class（Menus.TMenuItem）
 end; 
 TPopupForm = class（TForm）
 private 
 FListBox：TListBox; 
 FPopupForm：TForm; 
 FPopupMenu：TPopupMenu; 
 FPopupCount：Integer; 
 procedure WMActivate（var AMessage：TWMActivate）;消息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;覆盖
程序CreateParams（var Params：TCreateParams）;覆盖
 public 
构造函数创建（AOwner：TComponent; APopupForm：TForm; 
 APopupMenu：TPopupMenu; APopupCount：Integer）;重新引入
结束
 
 var 
 PopupForm：TPopupForm; 
 
实现
 
 {$ R * .dfm} 
 
 {TPopupForm} 
 
构造函数TPopupForm.Create（AOwner： TComponent; APopupForm：TForm; 
 APopupMenu：TPopupMenu; APopupCount：Integer）; 
 var 
 I：整数; 
 MaxWidth：Integer; 
 MaxHeight：整数; 
 ItemWidth：Integer; 
 ItemHeight：Integer; 
 begin 
继承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 ）; 
如果ItemWidth> MaxWidth然后
 MaxWidth：= ItemWidth; 
 if I< FPopupCount然后
 MaxHeight：= MaxHeight + ItemHeight; 
 FListBox.Items.Add（''）; 
结束
 finally 
 FListBox.Items.EndUpdate; 
结束
如果FPopupMenu.Items.Count> FPopupCount然后
 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; 
结束
 
程序TPopupForm.CreateParams（var Params：TCreateParams）; 
开始
继承; 
 Params.WindowClass.Style：= Params.WindowClass.Style或CS_DROPSHADOW; 
结束
 
 procedure TPopupForm.ListBoxDrawItem（Control：TWinControl; Index：Integer; 
 Rect：TRect; State：TOwnerDrawState）; 
 begin 
 DrawMenuItem（FPopupMenu.Items [Index]，FListBox.Canvas，Rect，State）; 
结束
 
 procedure TPopupForm.ListBoxKeyDown（Sender：TObject; var Key：Word; 
 Shift：TShiftState）; 
 begin 
 case 
的关键字VK_ESCAPE：关闭; 
 VK_RETURN：
开始
关闭; 
如果FListBox.ItemIndex<> -1然后
 FPopupMenu.Items [FListBox.ItemIndex] .Click; 
结束
结束
结束
 
 procedure TPopupForm.ListBoxMeasureItem（Control：TWinControl; Index：Integer; 
 var Height：Integer）; 
 var 
 ItemWidth：Integer; 
 begin 
 TMenuItem（FPopupMenu.Items [Index]）。MeasureItem（FListBox.Canvas，ItemWidth，
 Height）; 
结束
 
 procedure TPopupForm.ListBoxMouseDown（Sender：TObject; Button：TMouseButton; 
 Shift：TShiftState; X，Y：Integer）; 
 begin 
 SetCapture（FListBox.Handle）; 
结束
 
 procedure TPopupForm.ListBoxMouseMove（Sender：TObject; Shift：TShiftState; X，
 Y：Integer）; 
 var 
 ItemIndex：Integer; 
 begin 
 ItemIndex：= FListBox.ItemAtPos（Point（X，Y），True）; 
如果ItemIndex<> FListBox.ItemIndex then 
 FListBox.ItemIndex：= ItemIndex; 
结束
 
 procedure TPopupForm.ListBoxMouseUp（Sender：TObject; Button：TMouseButton; 
 Shift：TShiftState; X，Y：Integer）; 
开始
关闭; 
如果FListBox.ItemIndex<> -1然后
 FPopupMenu.Items [FListBox.ItemIndex] .Click; 
结束
 
程序TPopupForm.Paint; 
开始
继承; 
 Canvas.Pen.Color：= clSilver; 
 Canvas.Rectangle（ClientRect）; 
结束
 
程序TPopupForm.WMActivate（var AMessage：TWMActivate）; 
 begin 
 SendMessage（FPopupForm.Handle，WM_NCACTIVATE，1，0）; 
继承; 
如果AMessage.Active = WA_INACTIVE then 
释放; 
结束
 
 {TPopupMenu} 
 
构造函数TPopupMenu.Create（AOwner：TComponent）; 
开始
继承; 
 FPopupMode：= pmStandard; 
 FPopupCount = 5; 
结束
 
 procedure TPopupMenu.Popup（X，Y：Integer）; 
 begin 
 case FPopupMode 
 pmCustom：
 with TPopupForm.Create（nil，FPopupForm，Self，FPopupCount）do 
 begin 
 Top：= Y; 
左：= X; 
显示; 
结束
 pmStandard：inherited; 
结束
结束
 
结束。 
  

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

只需将 PopupUnit 添加到使用的末尾子句和弹出菜单控件将获得新的属性。

如果要使用自定义表单而不是真实菜单的模式，请使用以下内容菜单弹出窗口：

  //这将启用自定义模式
 PopupMenu1.PopupMode：= pmCustom; 
 //这将把当前关注的表单伪造成活动的，必须要
 //将当前关注的表单分配给此属性（至少现在）;所以Self 
 //这里使用的是当前集中的表单
 PopupMenu1.PopupForm：= Self; 
 //这将显示5个菜单项，其余的将通过滚动条访问
 PopupMenu1.PopupCount：= 5; 
  

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

  PopupMenu1.PopupMode：= pmStandard; 
  

免责声明：

代码需要检查（至少有缺少的菜单快捷键实现），一些部分应该改进。

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.

解决方案

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.

这篇关于如何使滚动条弹出菜单？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！