Question

我想在我现有的Delphi应用程序的弹出菜单中添加滚动条（和/或滚轮支持），因为它们通常高于屏幕，并且内置滚动不够好。 How to make a popup menu with scrollbar?对我来说是一个很好的解决方案，除了它不支持子菜单，我绝对需要。自去年7月以来，该解决方案的作者一直没有使用StackOverflow，所以我不认为他会回复我的评论。任何人都可以看到如何修改该代码以添加对子菜单的支持？如果重要，我需要它与Delphi 2007一起工作。

Answer 1

我分享了@ KenWhite对用户如何收到大量菜单的保留意见。向他和读者道歉，以下可能会冒犯他人; =）

无论如何，我希望下面的代码原则上显示，它很简单创建一个基于TPopUpMenu的TreeView（参见例程Array ( [0] => Array ( [name] => John Doe [address] => Array ( [0] => Los Angeles [1] => San Francisco ) [presenter] => Array ( [0] => 1 ) ) [1] => Array ( [name] => Jane Doe [address] => Array ( [0] => New York [1] => Chicago ) [presenter] => Array ( [0] => 0 ) ) )），它反映了PopUpMenu的结构，包括子项，并使用TreeView的自动垂直滚动条。在代码中， PopUpMenu恰好与TreeView在同一个窗体上，但这只是为了当然，紧凑性 - PopUpMenu可能完全是另一种形式。

正如评论中所提到的，我个人会基于这样的东西 TVirtualTreeView（http://www.soft-gems.net/index.php/controls/virtual-treeview）因为它比标准的TTreeView更具可定制性。

PopUpMenuToTree

Answer 2

这就是我所做的，通过合并How to make a popup menu with scrollbar?，MartynA的代码和我自己的代码：

unit PopupUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, Menus, ComCtrls;

type
  TPopupMode = (pmStandard, pmCustom);
  TPopupMenu = class(Menus.TPopupMenu)
  private
    FPopupForm: TForm;
    FPopupMode: TPopupMode;
  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;
  end;

type
  TPopupForm = class(TForm)
  private
    FPopupForm: TForm;
    FPopupMenu: TPopupMenu;
    FTreeView: TTreeView;
    procedure DoResize;
    procedure TreeViewClick(Sender: TObject);
    procedure TreeViewCollapsedOrExpanded(Sender: TObject; Node: TTreeNode);
    procedure TreeViewKeyPress(Sender: TObject; var Key: Char);
    procedure WMActivate(var AMessage: TWMActivate); message WM_ACTIVATE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent; APopupForm: TForm;
      APopupMenu: TPopupMenu); reintroduce;
  end;

var
  PopupForm: TPopupForm;

implementation

{$R *.dfm}

{ TPopupForm }

constructor TPopupForm.Create(AOwner: TComponent; APopupForm: TForm;
  APopupMenu: TPopupMenu);

  procedure AddItem(Item : TMenuItem; ParentNode : TTreeNode);
  var
    I : Integer;
    Node : TTreeNode;
  begin
    if Item.Caption <> '-' then begin
      Node := FTreeView.Items.AddChildObject(ParentNode, Item.Caption, Item);
      Node.ImageIndex := Item.ImageIndex;
      for I := 0 to Item.Count - 1 do begin
        AddItem(Item.Items[I], Node);
      end;
    end;
  end;

var
  I: Integer;
begin
  inherited Create(AOwner);
  BorderStyle := bsNone;

  FPopupForm := APopupForm;
  FPopupMenu := APopupMenu;

  FTreeView := TTreeView.Create(Self);
  FTreeView.Parent := Self;
  FTreeView.Align := alClient;
  FTreeView.BorderStyle := bsSingle;
  FTreeView.Color := clMenu;
  FTreeView.Images := FPopupMenu.Images;
  FTreeView.ReadOnly := TRUE;
  FTreeView.ShowHint := FALSE;
  FTreeView.ToolTips := FALSE;
  FTreeView.OnClick := TreeViewClick;
  FTreeView.OnCollapsed := TreeViewCollapsedOrExpanded;
  FTreeView.OnExpanded := TreeViewCollapsedOrExpanded;
  FTreeView.OnKeyPress := TreeViewKeyPress;

  FTreeView.Items.BeginUpdate;
  try
    FTreeView.Items.Clear;
    for I := 0 to FPopupMenu.Items.Count - 1 do
    begin
      AddItem(FPopupMenu.Items[I], NIL);
    end;
  finally
    FTreeView.Items.EndUpdate;
  end;
  DoResize;
end;

procedure TPopupForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

procedure TPopupForm.DoResize;
const
  BORDER = 2;
var
  ItemRect, TVRect : TRect;
  MF : TForm;
  Node : TTreeNode;
begin
  TVRect := Rect(0, 0, 0, 0);
  Node := FTreeView.Items[0];
  while Node <> NIL do begin
    ItemRect := Node.DisplayRect(TRUE);
    ItemRect.Right := ItemRect.Right + FTreeView.Images.Width + 1;
    if ItemRect.Left < TVRect.Left then
      TVRect.Left := ItemRect.Left;
    if ItemRect.Right > TVRect.Right then
      TVRect.Right := ItemRect.Right;
    if ItemRect.Top < TVRect.Top then
      TVRect.Top := ItemRect.Top;
    if ItemRect.Bottom > TVRect.Bottom then
      TVRect.Bottom := ItemRect.Bottom;
    Node := Node.GetNextVisible;
  end;
  MF := Application.MainForm;
  if Top + TVRect.Bottom - TVRect.Top > MF.Top + MF.ClientHeight then begin
    TVRect.Bottom := TVRect.Bottom -
      (Top + TVRect.Bottom - TVRect.Top - (MF.Top + MF.ClientHeight));
  end;
  if Left + TVRect.Right - TVRect.Left > MF.Left + MF.ClientWidth then begin
    TVRect.Right := TVRect.Right -
      (Left + TVRect.Right - TVRect.Left - (MF.Left + MF.ClientWidth));
  end;
  ClientHeight := TVRect.Bottom - TVRect.Top + BORDER * 2;
  ClientWidth := TVRect.Right - TVRect.Left + BORDER * 2;
end;

procedure TPopupForm.TreeViewClick(Sender: TObject);
var
  Node : TTreeNode;
  Item : TMenuItem;
begin
  if Sender is TTreeView then begin
    Node := TTreeView(Sender).Selected;
    if assigned(Node) then begin
      Item := TMenuItem(Node.Data);
      if assigned(Item.OnClick) then begin
        Item.Click;
        Close;
      end;
    end;
  end;
end;

procedure TPopupForm.TreeViewCollapsedOrExpanded(Sender: TObject;
  Node: TTreeNode);
begin
  DoResize;
end;

procedure TPopupForm.TreeViewKeyPress(Sender: TObject; var Key: Char);
begin
  if Ord(Key) = VK_RETURN then begin
    TreeViewClick(Sender);
  end
  else if Ord(Key) = VK_ESCAPE then begin
    Close;
  end;
end;

procedure TPopupForm.WMActivate(var AMessage: TWMActivate);
begin
  SendMessage(FPopupForm.Handle, WM_NCACTIVATE, 1, 0);
  inherited;
  if AMessage.Active = WA_INACTIVE then
    Release;
  FTreeView.Select(NIL, []);
end;

{ TPopupMenu }

constructor TPopupMenu.Create(AOwner: TComponent);
begin
  inherited;
  FPopupMode := pmStandard;
end;

procedure TPopupMenu.Popup(X, Y: Integer);
begin
  case FPopupMode of
    pmCustom:
    with TPopupForm.Create(nil, FPopupForm, Self) do
    begin
      Top := Y;
      Left := X;
      Show;
    end;
    pmStandard: inherited;
  end;
end;

end.

如何使用也支持子菜单的滚动条创建弹出菜单

2 个答案: