PopupMenu上での右クリック取得

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    popDir: TPopupMenu;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    m_HookHandle: THandle;
    procedure s_CreateDirMenu(OwnerMenu: TMenuItem);
    procedure s_CreateDirPopMenu(OwnerMenu: TMenuItem; sPath: string);
  end;

var
  Form1: TForm1;
  m_bIsPushMenu: Boolean;
  m_mnuItem: TMenuItem;     // ランチャー右クリック用メニューアイテム
implementation

{$R *.dfm}

function MsgProc(nCode: integer; wParam, lParam: LRESULT): LRESULT; stdcall;
  // メニューの一番上を取得
  function s_GetParent(mnuItem: TMenuItem): TMenuItem;
  var
    Parent: TMenuItem;
  begin
    Parent := mnuItem;
    while Assigned(Parent.Parent.Parent) do begin
      Parent := Parent.Parent;
    end;
    Result := Parent;
  end;
var
  cwp: PCWPStruct;
  mnuItem :TMenuItem;
  mnu: HMenu;
  bButton: boolean;
  FindKind: TFindItemKind;
  intItem: Integer;

  wIDItem: Word;
  wMenuFlag: Word;
begin
  if (nCode = HC_ACTION) then
  begin
    cwp := PCWPStruct(lParam);

    case cwp^.message of
      WM_ENTERIDLE:
      begin
        bButton := GetKeyState(VK_RBUTTON) < 0;
        if bButton then
        begin
          m_bIsPushMenu := true;
        end else begin
          if m_bIsPushMenu then
          begin
            s_DebugMsg(Format('mnuItem取得=%s',[m_mnuItem.Hint]));
            m_bIsPushMenu := False;
          end;
        end;
      end;

      WM_MENUSELECT:
      begin

(*
        s_DebugMsg(Format('WM_MENUSELECT:hwnd=%d, wParam=%d, lParam=%d',[cwp^.hwnd ,cwp^.wParam, cwp^.lParam]));
uItem  =  wParam & 0xFFFF;           // メニューアイテム
uFlags = (wParam >> 16) & 0xFFFF;    // メニューフラグ
hMenu  =  lParam;                    // メニューハンドル
*)
        wIDItem := cwp^.wParam and $FFFF;            // メニューアイテム
        wMenuFlag := (cwp^.wParam shr 16) and $FFFF; // メニューフラグ
        mnu := cwp^.lParam;                        // メニューハンドル

        if (mnu = 0) or (wMenuFlag = $FFFF) then
        begin
          m_bIsPushMenu := False;
          m_mnuItem := nil;
        end else begin

          FindKind := fkCommand;
          if wMenuFlag and MF_POPUP <> 0 then
            FindKind := fkHandle;
          if FindKind = fkHandle then
          begin
          if mnu <> 0 then
            intItem := GetSubMenu(mnu, wIDItem)
          else
            intItem := -1;
          end
          else intItem := wIDItem;
          mnuItem := Form1.popDir.FindItem(intItem, FindKind);
          if mnuItem <> nil then
          begin
            m_mnuItem := mnuItem;
            //s_DebugMsg(Format('mnuItem取得=%s',[mnuItem.caption]));
          end;
        end;
      end;

      WM_INITMENUPOPUP:
      begin
        mnu := HMenu(cwp^.wParam);
        mnuItem := nil;
        if mnu <> 0 then begin
          mnuItem := Form1.popDir.FindItem(mnu, fkHandle);
        end;
        if Assigned(mnuItem) then
        begin
          Form1.s_CreateDirMenu(mnuItem);
          //s_DebugMsg(Format('mnuItem取得=%s',[mnuItem.caption]));
        end;
//        s_DebugMsg('MsgProc:WM_INITMENUPOPUP');
      end;
    end;
  end;
  Result := CallNextHookEx(Form1.m_HookHandle, nCode, wParam, lParam);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  popDir.Items.Clear;

  s_CreateDirPopMenu(popDir.Items , 'C:\');
  popDir.Popup(100,100);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  m_bIsPushMenu := False;

  m_HookHandle := SetWindowsHookEx(WH_CALLWNDPROC, MsgProc,0,
    GetCurrentThreadId());

  s_DebugMsg(Format('m_HookHandle=%d',[m_HookHandle]));
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if m_HookHandle <> 0 then
    UnhookWindowsHookEx(m_HookHandle);
end;

// フォルダリストメニューの作成
procedure TForm1.s_CreateDirMenu(OwnerMenu: TMenuItem);
var
  sDir: String;
  SearchRec: TSearchRec;
  ii: Integer;
  sList: TStringList;
  lngY: Integer;
  lngMenuY: Integer;
  lngMax: Integer;
begin

  // ウィンドウサイズの取得
  lngY := GetSystemMetrics(SM_CYSCREEN);

  // フォントの高さ取得
  lngMenuY := GetMenuFontHeight();
  // メニューの数調整。メニューがはみ出さないように、少し余裕を持たせてある
  // 他にいい方法があれば、要変更
  // メニューにセパレータがある場合は、別の方法が必要
  lngMenuY := Trunc(lngMenuY * 1.35 + 5);

  lngMax := 10;
  if (lngY > 0) and (lngMenuY > 0) then begin
    lngMax := Trunc(lngY / lngMenuY);
  end;

  sDir := IncludeTrailingPathDelimiter(OwnerMenu.Hint);
  sList := TstringList.Create ;
  try
    // ディレクトリを検索
    if FindFirst(sDir + '*.*', faDirectory + faHidden + faSysFile, SearchRec) = 0 then begin
      try
        repeat
          if (SearchRec.Name='.') or (SearchRec.Name='..') then Continue;
          if (SearchRec.Attr and faDirectory) <> 0 then begin
            sList.Add(SearchRec.Name);
          end;
        until 0 <> FindNext(SearchRec);
      finally
        FindClose(SearchRec);
      end;
    end;
    // フォルダのソート
    sList.Sort;

    for ii:=0 to sList.Count -1 do begin
      // メニューの数が追加するフォルダと同じ場合
      // 新しいメニューアイテムを作成
      if ii = OwnerMenu.Count then
          OwnerMenu.Add(TMenuItem.Create(Self));
      OwnerMenu.Items[ii].Caption:= ExtractFileName(sList.Strings[ii]);
      OwnerMenu.Items[ii].Hint := sDir + sList.Strings[ii];
      // ダミーメニュー作成
      OwnerMenu.Items[ii].Add(TMenuItem.Create(Self));

      OwnerMenu.Items[ii].Break := mbNone;
      //　メニューの改行処理
      if (ii > 0) then begin
        if ((ii mod lngMax)= 0) then begin
          OwnerMenu.Items[ii].Break := mbBarBreak;
        end;
      end;

    end;

    // 余分なメニューの削除
    while OwnerMenu.Count > sList.Count do begin
      if OwnerMenu.Count = 1 then break;
      OwnerMenu.Items[OwnerMenu.Count-1].Free;
    end;

  finally
    sList.Free;
  end;

end;

// フォルダリストメニューの作成(リンクバー用)
procedure TForm1.s_CreateDirPopMenu(OwnerMenu: TMenuItem; sPath: string);
var
  sDir: String;
  SearchRec: TSearchRec;
  ii: Integer;
  sList: TStringList;
  NewItem: TMenuItem;
begin

  // 解放処理
  for ii:=OwnerMenu.Count - 1 downto 0 do begin
    OwnerMenu.Items[ii].Free;
  end;

  sDir := IncludeTrailingPathDelimiter(sPath);
  sList := TstringList.Create ;
  try
    // ディレクトリを検索
    if FindFirst(sDir + '*.*', faDirectory + faHidden + faSysFile, SearchRec) = 0 then begin
      try
        repeat
          if (SearchRec.Name='.') or (SearchRec.Name='..') then Continue;
          if (SearchRec.Attr and faDirectory) <> 0 then begin
            sList.Add(SearchRec.Name);
          end;
        until 0 <> FindNext(SearchRec);
      finally
        FindClose(SearchRec);
      end;
    end;
    // フォルダのソート
    sList.Sort;

    for ii:=0 to sList.Count -1 do begin
      // 新しいメニューアイテムを作成
      NewItem := TMenuItem.Create(self);
      NewItem.Caption := ExtractFileName(sList.Strings[ii]);
      NewItem.Hint := sDir + sList.Strings[ii];
      NewItem.Visible := True;
      NewItem.Enabled := True;
      // NewItem.OnClick := FavoriteMenuProc;
      OwnerMenu.Add(NewItem);

      // ダミーメニュー作成
      OwnerMenu.Items[ii].Add(TMenuItem.Create(Self));

    end;
  finally
    sList.Free;
  end;

end;

end.