Delphi XE2 では、ユーザーがマウスの左ボタンまたは右ボタンでポップアップ メニュー項目をクリックしたかどうかをどのように検出できますか?
4 に答える
このユニットを使用して、コンポーネントとしてインストールし、イベント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でテストしたばかりで、正常に動作します。
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;
ポップアップメニューの処理は、Windowsの一部であるuser32.dll
という関数の内部で行われます。TrackPopupMenu
左クリックまたは右クリックに応答して、WM_COMMAND
メッセージが生成されます。このメッセージは、DelphiVCLフレームワークコードによって処理されます。wParam
パラメータには、実行中のメニュー項目のインデックスが含まれており、は常にLParam
ゼロのように見えます。
左クリックと右クリックで異なる応答をするメニューを作成する唯一の方法は、Windowsからではなく、自分でポップアップメニューを生成することです。
Windowsの設計者がこの情報をウィンドウメッセージ内のWParamまたはLParamの一部として渡すことにした場合は、おそらくこれを使用して何かを行ったか、ポップアップの一部であるマウスダウンイベントをフックできます。メニューのウィンドウメッセージループ、あなたはおそらくこれを行うことができますが、私はこれを行うための信頼できる手段を知りません。
左クリックメニューと右クリックメニューで異なる処理が本当に必要な場合は、独自のポップアップメニューを作成するのはおそらく手間がかかりません。しかし、その場合、ユーザーはアプリケーションの使用方法を知りません。このようなアイデアは推奨されておらず、実際、私が知っている標準のWin32メニューでは不可能です。
著者と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;