>ヒントウィンドウ等も表示した方がいいかも知れません．
残念ながら，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.
 |
