名前
題名
▼ Mr.XRAYさん > ポップアップメニューを表示して，そのメニューのウィンドウの上で > マウスの右ボタンクリックで，別のポップアップメニューを表示するサンプルです． > > (1) 新規にプロジェクトを作成して，保存します． > (2) Delphi のソースコードの Menu.pas をプロジェクトのフォルダにコピーします． > (3) Menu.pas に，以下の 1 行を追加します． > TPM_RECURSE を追加すると右クリックで閉じなくなります． > > procedure TPopupMenu.Popup(X, Y: Integer); > ... > ... > AFlags := AFlags or TPM_RECURSE; //追加 > TrackPopupMenu(FItems.Handle, AFlags, X, Y, 0 { reserved }, PopupList.Window, nil); > end; > > (4) TPopupMenu コンポを 2 つフォームに配置して，適当に項目を作成します． > (5) TPanel コンポを 1 つ配置します． > (5) Form1 の PopupMenu プロパティを PopupMenu1 にします． > (6) テスト用のコードを以下のようにします． > > 面白そうなので，サブのポップアップメニューをいくつでも表示できるようにして > います． > 動作確認は，Windows 7 U64(SP1) + Delphi XE(UP1) Pro です． > > > unit Unit1; > > interface > > uses > Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, > Dialogs, StdCtrls, ExtCtrls, Menus; > > type > TPopupListEx = class(TPopupList) > protected > procedure WndProc(var Message: TMessage) ; override; > end; > > TForm1 = class(TForm) > Button1: TButton; > PopupMenu1: TPopupMenu; > Item_0: TMenuItem; > Item_1: TMenuItem; > Item_2: TMenuItem; > Item_3: TMenuItem; > N1: TMenuItem; > Panel1: TPanel; > PopupMenu2: TPopupMenu; > Item_20: TMenuItem; > Item_21: TMenuItem; > Item_22: TMenuItem; > Item_23: TMenuItem; > private > { Private 宣言 } > protected > procedure WMExitMenuLoop(var Message: TWMExitMenuLoop); > message WM_EXITMENULOOP; > procedure WMEnterMenuLoop(var Message: TWMEnterMenuLoop); > message WM_ENTERMENULOOP; > procedure WMMenuSelect(var Message: TWMMenuSelect); > message WM_MENUSELECT; > public > { Public 宣言 } > procedure WMApp100(var Message: TMessage); message WM_APP+100; > end; > > var > Form1: TForm1; > > implementation > > {$R *.dfm} > > var > hMouseHook : HHOOK; > > //----------------------------------------------------------------------------- > // マウスフックのコールバック関数 > // Form1にメッセージを送る > // ポップアップメニュー上のマウスカーソル位置は，フックでないと検出不可 > //----------------------------------------------------------------------------- > function MouseHookProc(nCode: Integer; wPar: WPARAM; lPar:LPARAM): > Integer; stdcall; > var > MousePos : TPoint; > begin > if nCode < 0 then begin > Result := CallNextHookEx(hMouseHook, nCode, wPar, lPar); > end else begin > if nCode = HC_ACTION then begin > MousePos := PMouseHookStruct(lPar)^.pt; > PostMessage(Form1.Handle, WM_APP+100, wPar, MakeLParam(MousePos.X, MousePos.Y)); > //PopupMenuのOnClickイベントを使用しない場合はResult := -1にしてExit; > //このコードにすると，TMenuItem.OnClickは検出できなくなる > Result := -1; > exit; > end; > Result := CallNextHookEx(hMouseHook, nCode, wPar, lPar); > end; > end; > > //----------------------------------------------------------------------------- > // PopupMenuが表示された時のメッセージ処理 > // マウスフックを開始する > //----------------------------------------------------------------------------- > procedure TForm1.WMEnterMenuLoop(var Message: TWMEnterMenuLoop); > begin > if hMouseHook = 0 then begin > hMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, 0, GetCurrentThreadID); > end; > end; > > //----------------------------------------------------------------------------- > // PopupMenuが閉じた時のメッセージ処理 > // マウスフックを終了して，PopupMeneを全て閉じる > //----------------------------------------------------------------------------- > procedure TForm1.WMExitMenuLoop(var Message: TWMExitMenuLoop); > var > MousePos : TPoint; > begin > GetCursorPos(MousePos); > > //1つでも閉じれば全て閉じることにする > SendMessage(Handle, WM_APP+100, WM_LBUTTONUP, MakeLParam(MousePos.X, MousePos.Y)); > if hMouseHook <> 0 then begin > UnhookWindowsHookEx(hMouseHook); > hMouseHook := 0; > end; > end; > > //----------------------------------------------------------------------------- > // PopupMenuで項目を選択された時のメッセージ処理 > // 選択されている項目名を表示 > // 実際に選択したかで項目を取得するには，WM_LBUTTONUPがいいかも知れない > // ただし，どの項目を選択したかは，このWM_MENUSELECTまたは > // TPopupList.WndProc内でないと取得は困難だろう > //----------------------------------------------------------------------------- > procedure TForm1.WMMenuSelect(var Message: TWMMenuSelect); > var > i : Integer; > MenuItem : TMenuItem; > begin > if (Message.MenuFlag = $FFFF) and (Message.Menu = 0) then exit; > > Panel1.Caption := ''; > for i := 0 to ComponentCount - 1 do begin > if Components[i].ClassName = 'TPopupMenu' then begin > if TPopupMenu(Components[i]).Handle = Message.Menu then begin > MenuItem := TPopupMenu(Components[i]).FindItem(Message.IDItem, fkCommand); > Panel1.Caption := MenuItem.Name; > Break; > end; > end; > end; > end; > > //----------------------------------------------------------------------------- > // ローカルマウスフックのメッセージを受信 > //----------------------------------------------------------------------------- > procedure TForm1.WMApp100(var Message: TMessage); > var > X : Integer; > Y : Integer; > hPopupWnd : HWND; > begin > X := LOWORD(Message.LParam); > Y := HIWORD(Message.LParam); > > //左ボタンUP(項目を選択した時)はTPopupMenuを全て閉じることにする > if (Message.WParam = WM_LBUTTONUP) then begin > while True do begin > hPopupWnd := FindWindow('#32768', nil); > if hPopupWnd = 0 then break; > > SendMessage(hPopupWnd, WM_CLOSE, 0, 0); > Application.ProcessMessages; > Sleep(1); > end; > end else > //右ボタンUPでは新しくTPopupMenuを表示する > if (Message.WParam = WM_RBUTTONUP) then begin > PopupMenu2.Popup(X, Y); > end; > end; > > > //----------------------------------------------------------------------------- > // PopupMenu内部のPopupListのメッセージ処理 > // これらのメッセージを受信したら，アプリのアクティブなフォームにメッセージを送る > //----------------------------------------------------------------------------- > > { TPopupListEx } > > procedure TPopupListEx.WndProc(var Message: TMessage); > begin > if Screen.Activeform <> nil then begin > if Message.Msg = WM_ENTERMENULOOP then begin > Screen.ActiveForm.Perform(WM_ENTERMENULOOP, Message.WParam, Message.LParam); > end else > if Message.Msg = WM_EXITMENULOOP then begin > Screen.ActiveForm.Perform(WM_EXITMENULOOP, Message.WParam, Message.LParam); > end; > if Message.Msg = WM_MENUSELECT then begin > Screen.ActiveForm.Perform(WM_MENUSELECT, Message.WParam, Message.LParam); > end; > end; > inherited; > end; > > initialization > Popuplist.Free; > PopupList:= TPopupListEx.Create; > > end. > > > 下図は，設計時と実行した画面です． > Panel1 に，(左ボタンDOWNまたは矢印キー等で)選択の項目名を表示します．
GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.
600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示).
(上限122000(120k)バイト)

削除キー Link