delphi - スクロールバー付きのポップアップメニューを作成するには?

Question

私TPopupMenuは自分のプログラムで使用しています。垂直スクロールバーを追加し、そのサイズ (たとえば 10 個の表示項目) を設定し、スライダースクロールバーを移動するイベントを処理したいと考えています (ボタンをクリックした後、またはマウスをスクロールした後)。車輪）。この機能を備えたコンポーネントが存在することを知りたいです。または、このコンポーネントの作成に関する理論を喜んでいます。たとえば、Vista/7 Explorer のアドレスバーのポップアップメニューと同様の動作が必要です (現在のフォルダー内のサブフォルダーのリストを使用)。

ありがとう。

score 11 · Accepted Answer

アップデート：

次のコードは、標準のポップアップメニューを拡張して、実際のメニューの代わりに独自のポップアップフォームを表示する方法を示しています。メニュー項目は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;

免責事項:

コードのレビューが必要で (少なくとも、メニューショートカットの実装がまったく欠落しています)、いくつかの部分を改善する必要があります。

delphi - スクロールバー付きのポップアップメニューを作成するには?

1 に答える 1

Related

Reference