0

Delphi XE2 では、ユーザーがマウスの左ボタンまたは右ボタンでポップアップ メニュー項目をクリックしたかどうかをどのように検出できますか?

4

4 に答える 4

1

このユニットを使用して、コンポーネントとしてインストールし、イベントTPopupMenuを追加する標準を置き換えます。OnMenuRightClick

unit RCPopupMenu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus;

type
  TMenuRightClickEvent = procedure (Sender: TObject; Item: TMenuItem) of object;

  TRCPopupList = class(TPopupList)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

  TRCPopupMenu = class(TPopupMenu)
  private
    FOnMenuRightClick: TMenuRightClickEvent;
  protected
    function DispatchRC(aHandle: HMENU; aPosition: Integer): Boolean;
    procedure RClick(aItem: TMenuItem);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Popup(X, Y: Integer); override;
  published
    property OnMenuRightClick: TMenuRightClickEvent read FOnMenuRightClick write FOnMenuRightClick;
  end;

procedure Register;

var
  RCPopupList: TRCPopupList;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TRCPopupMenu]);
end;

{ TRCPopupList }

procedure TRCPopupList.WndProc(var Message: TMessage);
var
  i: Integer;
  pm: TPopupMenu;
begin
  if Message.Msg = WM_MENURBUTTONUP then
  begin
    for I := 0 to Count - 1 do
    begin
      pm := TPopupMenu(Items[i]);
      if pm is TRCPopupMenu then
        if TRCPopupMenu(Items[i]).DispatchRC(Message.lParam, Message.wParam) then
          Exit;
    end;
  end;
  inherited WndProc(Message);
end;

{ TRCPopupMenu }

constructor TRCPopupMenu.Create(AOwner: TComponent);
begin
  inherited;
  PopupList.Remove(Self);
  RCPopupList.Add(Self);
end;

destructor TRCPopupMenu.Destroy;
begin
  RCPopupList.Remove(Self);
  PopupList.Add(Self);
  inherited;
end;

function TRCPopupMenu.DispatchRC(aHandle: HMENU; aPosition: Integer): Boolean;
begin
  Result := False;
  if Handle = aHandle then
  begin
    RClick(Items[aPosition]);
    Result := True;
  end;
end;

procedure TRCPopupMenu.Popup(X, Y: Integer);
const
  Flags: array[Boolean, TPopupAlignment] of Word =
    ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN),
    (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN));
  Buttons: array[TTrackButton] of Word = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
var
  AFlags: Integer;
begin
  DoPopup(Self);
  AFlags := Flags[UseRightToLeftAlignment, Alignment] {or Buttons[TrackButton]};
  if (Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and (Win32MinorVersion > 0)) then
  begin
    AFlags := AFlags or (Byte(MenuAnimation) shl 10);
    AFlags := AFlags or TPM_RECURSE;
  end;
  TrackPopupMenuEx(Items.Handle, AFlags, X, Y, RCPopupList.Window, nil);
end;

procedure TRCPopupMenu.RClick(aItem: TMenuItem);
begin
  if Assigned (FOnMenuRightClick) then
    FOnMenuRightClick(Self, aItem);
end;

var
  oldPL: TPopupList;

initialization
  RCPopupList := TRCPopupList.Create;
finalization
  RCPopupList.Free;

end.

その後、イベントを使用OnMenuRightClickして、右クリックでアクションを実行できます。

注:私はこのユニットを作成しませんでした-誰が作成したかはわかりませんが、クレジットは誰が作成したかになります...ただし、Delphi XE2でテストしたばかりで、正常に動作します。

于 2012-10-24T02:46:01.940 に答える
1

TLama とそのコードの作者に感謝します! 非常に便利ですが、マイナーな更新が必要です。その手順は、アイテムの最初のレベルでチェックするだけです。メニューにサブアイテムが含まれている場合、機能しませんでした...したがって、DispatchRC関数をオーバーロードして再帰検索を行う必要がありますクリックされた項目。私はそれをしました、そしてそれはうまくいきます:

function TRCPopupMenu.DispatchRC(aHandle: HMENU; aPosition: Integer): Boolean;
begin
  //Result := False; // freezebit : now, unused value
  if Handle = aHandle then
  begin
    RClick(Items[aPosition]);
    Result := True;
    Exit; // freezebit : found, so leave
  end;
  Result := DispatchRC(aHandle, aPosition, Items); // freezebit : now make a recursive search in all sub-items
end;

// freezebit : this function search in all sub-items recursively if we found the right-clicked TMenuItem
function TRCPopupMenu.DispatchRC(aHandle: HMENU; aPosition: Integer; aItems: TMenuItem): Boolean;
var
  i: integer;
  itm: TMenuItem;
begin
  Result := False;
  for i := 0 to aItems.Count - 1 do begin
    itm := aItems[i];
    if itm.Count = 0 then
      Continue;
    if itm.Items[0].Parent.Handle = aHandle then begin
      RClick(itm.Items[aPosition]);
      Result := True;
      Exit;
    end;
    if DispatchRC(aHandle, aPosition, itm) then begin
      Result := True;
      Exit;
    end;
  end;
end;
于 2014-12-08T23:20:58.527 に答える
0

ポップアップメニューの処理は、Windowsの一部であるuser32.dllという関数の内部で行われます。TrackPopupMenu左クリックまたは右クリックに応答して、WM_COMMANDメッセージが生成されます。このメッセージは、DelphiVCLフレームワークコードによって処理されます。wParamパラメータには、実行中のメニュー項目のインデックスが含まれており、は常にLParamゼロのように見えます。

左クリックと右クリックで異なる応答をするメニューを作成する唯一の方法は、Windowsからではなく、自分でポップアップメニューを生成することです。

Windowsの設計者がこの情報をウィンドウメッセージ内のWParamまたはLParamの一部として渡すことにした場合は、おそらくこれを使用して何かを行ったか、ポップアップの一部であるマウスダウンイベントをフックできます。メニューのウィンドウメッセージループ、あなたはおそらくこれを行うことができますが、私はこれを行うための信頼できる手段を知りません。

左クリックメニューと右クリックメニューで異なる処理が本当に必要な場合は、独自のポップアップメニューを作成するのはおそらく手間がかかりません。しかし、その場合、ユーザーはアプリケーションの使用方法を知りません。このようなアイデアは推奨されておらず、実際、私が知っている標準のWin32メニューでは不可能です。

于 2012-10-24T02:16:32.220 に答える
-1

著者とfreezebitに感謝しますが、このソリューションは少し美しく思います(DispatchRCも変更されました):

function TRCPopupMenu.DispatchRC(aHandle: HMENU; aPosition: Integer): Boolean;
var FParentItem: TMenuItem;
begin
  Result := False;
  if Handle = aHandle then
    FParentItem := Items
  else
    FParentItem := FindItem(aHandle, fkHandle);
  if FParentItem <> nil then
    begin
      RClick(FParentItem.Items[aPosition]);
      Result := True;
    end;
{  if Handle = aHandle then
  begin
    RClick(Items[aPosition]);
    Result := True;
  end;}
end;
于 2015-06-12T21:55:46.387 に答える