名前
題名
▼ Mr.XRAYさん > >ヒントウィンドウ等も表示した方がいいかも知れません． > > 残念ながら，TPopupMenu は Delphi のコントロールではなく， > Windows API の TrackPopupMenu を実行しています． > したがって，そのままではヒントウィドウを表示できません． > ヒントプロパティを実装すればできるかも知れませんが，確認していません． > TPopupMenu あるいは TMenuItem が TPanel のようにコンテナにできれば， > 自由に他のコントロールが配置できるのですが... > > 下の図は，サンプルプログラム集の [261_マウスカーソル位置に画像を表示] を > 実行してから，次のコードを実行したものです． > カエルの画像の代わりに，文字列を表示すれば，ヒントウィンドウの代わりに > なるかと思います． > 文字列は，Item の画像の位置，つまりマウスカーソルの位置によって変更します． > > そのためには，マウスカーソルの位置を知る必要があります． > そこで，マウスのローカルフックを実行しています． > フックは，アプリ開始と同時に開始して，終了時に終了してもいいのですが， > ポップアップメニュー表示開始時にフック開始とし，閉じたらフック終了に > することにしています． > > TPopupMenu には，ポップアップウィンドウ以外の場所をクリックして閉じた時の > イベントがありません． > そこで，TPopupList.WndProc で，WM_EXITMENULOOP を検出しています． > > > unit Unit1; > > interface > > uses > Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, > Dialogs, StdCtrls, ExtCtrls, Menus, ImgList; > > 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; > ImageList1: TImageList; > Panel1: TPanel; > procedure Item_0AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; > ARect: TRect; State: TOwnerDrawState); > procedure Item_0MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, > Height: Integer); > procedure Item_0Click(Sender: TObject); > procedure PopupMenu1Popup(Sender: TObject); > private > { Private 宣言 } > RectImage : array [0..3] of TRect; > protected > procedure WMExitMenuLoop(var Message: TWMExitMenuLoop); > message WM_EXITMENULOOP; > 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)); > end; > Result := CallNextHookEx(hMouseHook, nCode, wPar, lPar); > end; > end; > > //----------------------------------------------------------------------------- > // PopupMenuを表示した時のイベント処理 > // マウスフックを開始する > //----------------------------------------------------------------------------- > procedure TForm1.PopupMenu1Popup(Sender: TObject); > begin > if hMouseHook = 0 then > hMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, 0, GetCurrentThreadID); > end; > > //----------------------------------------------------------------------------- > // PopupMenuが閉じた時のメッセージ処理 > // マウスフックを終了する > //----------------------------------------------------------------------------- > procedure TForm1.WMExitMenuLoop(var Message: TWMExitMenuLoop); > begin > if hMouseHook <> 0 then begin > UnhookWindowsHookEx(hMouseHook); > hMouseHook := 0; > end; > Panel1.Caption := '閉じた'; > end; > > //----------------------------------------------------------------------------- > // PopupMenu1のItem_0項目のOnAdvancedDrawItemイベント処理 > // ImageListに格納してあるビットマップ画像を表示 > // > // PopupMenu1のOwnerDrawプロパティをTrueにしておく > //----------------------------------------------------------------------------- > procedure TForm1.Item_0AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; > ARect: TRect; State: TOwnerDrawState); > var > aBitmap : TBitmap; > ItemWidth : Integer; > ItemHeigh : Integer; > aLeft : Integer; > aPos : TPoint; > infMargin : Integer; > i : Integer; > begin > ItemWidth := ImageList1.Width + 5; > ItemHeigh := ImageList1.Height + 10; > aPos := PopupMenu1.PopupPoint; > > aBitmap := TBitmap.Create; > try > infMargin := -5; > InflateRect(ARect, infMargin, infMargin); > > aLeft := ARect.Left + 5; > aPos.X := aPos.X + 5 - infMargin; > for i := 0 to Length(RectImage) - 1 do begin > RectImage[i] := Rect(aPos.X, aPos.Y, aPos.X + ItemWidth, aPos.Y + ItemHeigh); > > aBitmap.Assign(nil); > ImageList1.GetBitmap(i, aBitmap); > ACanvas.Draw(aLeft, ARect.Top, aBitmap); > aLeft := aLeft + ItemWidth; > aPos.X := aPos.X + ItemWidth; > end; > finally > aBitmap.Free; > end; > end; > > //----------------------------------------------------------------------------- > // PopupMenu1のItem_0項目のOnMeasureItemイベント処理 > // 項目の幅と高さを設定 > //----------------------------------------------------------------------------- > procedure TForm1.Item_0MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, > Height: Integer); > begin > Height := ImageList1.Height + 10; > Width := (ImageList1.Width + 5) * Length(RectImage); > end; > > //----------------------------------------------------------------------------- > // PopupMenu1のItem_0項目のOnClickイベント処理 > // クリックした画像を，マウスクカーソルの位置から判定する > //----------------------------------------------------------------------------- > procedure TForm1.Item_0Click(Sender: TObject); > var > aPos : TPoint; > i : Integer; > begin > if TMenuItem(Sender) = Item_0 then begin > GetCursorPos(aPos); > > for i := 0 to Length(RectImage) - 1 do begin > if PtInRect(RectImage[i], aPos) then begin > ShowMessage(IntToStr(i + 1) + ' 番目の画像クリック'); > break; > end; > end; > > if hMouseHook <> 0 then begin > UnhookWindowsHookEx(hMouseHook); > hMouseHook := 0; > end; > end; > > Panel1.Caption := '閉じた'; > end; > end; > > //----------------------------------------------------------------------------- > // ローカルマウスフックのメッセージを受信 > // マウスカーソルの座標値を取得して表示 > //----------------------------------------------------------------------------- > procedure TForm1.WMApp100(var Message: TMessage); > var > X : Integer; > Y : Integer; > begin > X := LOWORD(Message.LParam); > Y := HIWORD(Message.LParam); > Panel1.Caption := 'X: ' + IntToStr(X) + ' Y: ' + IntToStr(Y); > end; > > > //----------------------------------------------------------------------------- > // PopupMenuが閉じるとWM_EXITMENULOOPメッセージを発行する > // このメッセージを受信したら，アプリのアクティブなフォームにメッセージを送る > //----------------------------------------------------------------------------- > > { TPopupListEx } > > procedure TPopupListEx.WndProc(var Message: TMessage); > begin > if Screen.Activeform <> nil then begin > if Message.Msg = WM_EXITMENULOOP then begin > Screen.ActiveForm.Perform(WM_EXITMENULOOP, 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