名前
題名
▼ Mr.XRAYさん > > > 面白そうなので，サブのポップアップメニューをいくつでも表示できるようにして > > > います． > > > > どうだ!! > > 実用性は全くありませんが． > > こんなことは実際にはしないと思います．で．真面目なコードに変更しました． > UP したファイルも整理しました．余分なプロジェクトを削除しています． > 変更した Menu.pas は含まれていません． > メインのメニューが TMainMenu の場合は修正が必要です． > > http://mrxray.on.coocan.jp/Delphi/zip/PopupMenu_ImageItem.zip > (1,122 KB) > > > 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; > PopupMenu2: TPopupMenu; > Item_20: TMenuItem; > Item_21: TMenuItem; > Item_22: TMenuItem; > Item_23: TMenuItem; > 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; > private > { Private 宣言 } > FSelectMenuItem : TMenuItem; > FClickMainMenuItem : TMenuItem; > FClickSubMenuItem : TMenuItem; > FShowSubPopup : Boolean; > 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)); > Result := -1; > exit; > end; > Result := CallNextHookEx(hMouseHook, nCode, wPar, lPar); > end; > end; > > //----------------------------------------------------------------------------- > // PopupMenuが表示された時のメッセージ処理 > // マウスフックを開始する > //----------------------------------------------------------------------------- > procedure TForm1.WMEnterMenuLoop(var Message: TWMEnterMenuLoop); > begin > if FShowSubPopup = False then begin > FClickMainMenuItem := nil; > FClickSubMenuItem := nil; > if hMouseHook = 0 then begin > hMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, 0, GetCurrentThreadID); > end; > end; > end; > > //----------------------------------------------------------------------------- > // PopupMenuが閉じた時のメッセージ処理 > // マウスフックを終了 > // クリックしたメニュー項目の名前(Captionプロパティの値)を表示 > // > // フックを解除しないでダイアログを表示すると本サンプルではハングアップする > // サブのポップアップを閉じたら，メインのメニューも閉じる > // メニューを表示したままダイアログを表示すると，メニューが最上位に表示される > // メニューは常にZオーダーが最上位のウィンドウとして表示される > // ダイアログを表示しなければメインのメニューは表示したままでもよい > // その場合，マウスフックは解除しない > // マウスフックを解除すると，サブのポップメニューが表示できなくなる > //----------------------------------------------------------------------------- > procedure TForm1.WMExitMenuLoop(var Message: TWMExitMenuLoop); > var > PopupPos : TPoint; > MainName : String; > SubName : String; > StrText : String; > begin > if hMouseHook <> 0 then begin > UnhookWindowsHookEx(hMouseHook); > hMouseHook := 0; > > MainName := ''; > SubName := ''; > if FShowSubPopup then begin > if FClickSubMenuItem = nil then FClickMainMenuItem := nil; > end; > if FClickMainMenuItem <> nil then MainName := FClickMainMenuItem.Name; > if FClickSubMenuItem <> nil then SubName := FClickSubMenuItem.Name; > StrText := 'Main: ' + MainName + sLineBreak + 'Sub: ' + SubName; > > PopupPos := PopupMenu1.PopupPoint; > SendMessage(Handle, WM_APP+100, WM_LBUTTONUP, MakeLParam(PopupPos.X, PopupPos.Y)); > > //コンポーネントにする場合は，ここでOnClickイベントを実行する > //TMainMenu,TPopupMenuのSenderはTMenuItemの1つだけ > //メインメニューのどの項目からサブのポップアップを表示したかは別のプロパティ > //として実装する必要があるだろう > MessageBox(Handle, PChar(StrText), '選択項目', MB_ICONINFORMATION); > end; > end; > > //----------------------------------------------------------------------------- > // PopupMenuで項目が選択された時のメッセージ処理 > //----------------------------------------------------------------------------- > procedure TForm1.WMMenuSelect(var Message: TWMMenuSelect); > var > FindKind : TFindItemKind; > ItemIndex : Integer; > begin > if (Message.MenuFlag = $FFFF) and (Message.Menu = 0) then exit; > > FindKind := fkCommand; > //サブメニュー > //本サンプルでは使用していない > if (Message.MenuFlag and MF_POPUP) <> 0 then begin > FindKind := fkHandle; > end; > > ItemIndex := -1; > if FindKind = fkHandle then begin > if Message.Menu <> 0 then begin > ItemIndex := GetSubMenu(Message.Menu, Message.IDItem); > end; > end else begin > ItemIndex := Message.IDItem; > end; > > FSelectMenuItem := nil; > //TMainMenu等を使用している場合は，その中を検索する > if PopupMenu1.Handle = Message.Menu then begin > FSelectMenuItem := PopupMenu1.FindItem(ItemIndex, FindKind); > end else > if PopupMenu2.Handle = Message.Menu then begin > FSelectMenuItem := PopupMenu2.FindItem(ItemIndex, FindKind); > end; > end; > > //----------------------------------------------------------------------------- > // ローカルマウスフックのメッセージを受信 > // > // このメッセージ内でダイアログ等を表示しないこと > // 本サンプルのフックのコールバック関数は，Form1のハンドルに対してだけ > // メッセージを送信するようにしている > // そのため，ダイアログ等を表示してしまうと，メッセージが受信できなくなる > // つまり，このメッセージ処理が実行されなくなってしまう > //----------------------------------------------------------------------------- > procedure TForm1.WMApp100(var Message: TMessage); > var > X : Integer; > Y : Integer; > hPopup : HWND; > begin > X := LOWORD(Message.LParam); > Y := HIWORD(Message.LParam); > > if (Message.WParam = WM_LBUTTONUP) or (Message.WParam = WM_RBUTTONUP) then begin > if (Message.WParam = WM_RBUTTONUP) and (FShowSubPopup = False) then begin > FClickMainMenuItem := FSelectMenuItem; > FShowSubPopup := True; > PopupMenu2.Popup(X, Y); > FShowSubPopup := False; > end else begin > while True do begin > hPopup := FindWindow('#32768', nil); > if hPopup = 0 then break; > SendMessage(hPopup, WM_CLOSE, 0, 0); > Application.ProcessMessages; > Sleep(1); > end; > > if FClickMainMenuItem = nil then begin > FClickMainMenuItem := FSelectMenuItem; > end else begin > FClickSubMenuItem := FSelectMenuItem; > end; > end; > 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. >
GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.
600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示).
(上限122000(120k)バイト)

削除キー Link