フォーラム


ゲスト  

ようこそ ゲスト さん。このフォーラムに投稿するには 登録が必要です。

ページ: [1]
トピック: TPopupMenu のメニューを画像にする
Mr.XRAY
メンバー
投稿数: 192
TPopupMenu のメニューを画像にする
on: 2014/10/04 13:50 Sat

ポップアップメニュー(TPopupMenu) のメニュー項目を画像にするサンプルです.
メニューの項目のカスタマイズに応用できます.例えば,フォント変更等の用途にも応用できます.
以下の方針で作成しています.

  • 最初の,先頭の項目に 4 つの画像を表示
  • 各々の画像のクリックを別々に検出する(クリッカブルマップの様な機能)
  • マウスカーソル位置の画像の背景色を変更する

下図は作成した EXE を実行した画像です.
テストなので,マウスカーソルの位置を表示するようにしています.
フォームに配置しているボタンは,操作とは無関係です.

TPopupMenu は,Windows API の TrackPopupMenu を実行しています.したがって,Delphi のコントロールのように,ボタン等は配置できません.OnAdvancedDrawItem イベントあるいは OnDrawItem イベントで描画することになります.
OnAdvancedDrawItem イベントには State 変数があり,Disable 等の画像を表示したりする時に便利です.

マウスカーソル位置の画像を知るためには,TPopupMenu ウィンドウ上のマウスカーソルの位置を知る必要があります.このために,マウスのローカルフックを使用しています.
TPopupMenu ウィンドウ上のマウスカーソル位置は,TApplication の OnMessage イベントでは捕捉できません.詳しくは以下を参考にしてください.

[第7章 メッセージを捕まえる : ローカルフック - Halbow]
http://mrxray.on.coocan.jp/Halbow/VCL07.html
[フック関数のインスタンス化 - Halbow]
http://mrxray.on.coocan.jp/Halbow/Notes/N006.html

マウスフックは,プログラム開始と同時に開始し,終了時に終了してもいいのですが,本サンプルでは,PopupMenu の表示開始と同時にフックを開始し,PopupMenu が閉じたらフックを終了しています.
そのために,TPopupMenu を表示開始した時と,閉じた時のメッセージを受信するようにしています.

マウスカーソルがある画像の背景色を変更するには,マウスカーソルが,対象の画像内に入った時に TPopupMenu を再描画することになります.
マウスカーソルが移動する度に再描画してしまうと,再描画によるチラつきが発生します.そこで,マウスカーソルがある画像の番号をグローバル変数に取得しておき,マウスカーソルが別の画像位置に入ったら再描画するようにしています.

以下は,設計時の画面と実際にテストに使用したコードです.
設計時に TImageList に描画する画像を格納しておき,実行時に描画用のイベント内でその画像を描画します.
TPopupMenu には,適当にメニュー項目を作成しておきます.
また,TPopupMenu の OwnerDrawプロパティをTrueにしておきます.
サンプルでは,Form1 の PopupMenu プロパティを PopupMenu1 にしています.

以下も参考にしてください.
http://mrxray.on.coocan.jp/bbs/DelphiBBS/mrxray_delphifan_coffe.cgi?tree=s8044#8044

サンプルのプロジェクトのダウンロード(EXE 同梱 : 1.122 KB 2014年10月08日版
http://mrxray.on.coocan.jp/Delphi/zip/PopupMenu_ImageItem.zip

動作確認は Wondos 7 U64(SP1) + Delphi XE(UP1) Pro ですが,おそらく Delphi 6 以降で使用可能と思われます.
[別バージョンで作成されたプロジェクトの利用]
http://mrxray.on.coocan.jp/Delphi/Others/Delphi_Versionl.htm

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 FormCreate(Sender: TObject);
procedure Item_0Click(Sender: TObject);
private
{ Private 宣言 }
RectImage : array [0..3] of TRect;
hPopupWnd : HWND;
CurrentImgIndex : Integer;
protected
procedure WMExitMenuLoop(var Message: TWMExitMenuLoop);
message WM_EXITMENULOOP;
procedure WMEnterMenuLoop(var Message: TWMEnterMenuLoop);
message WM_ENTERMENULOOP;
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;

//-----------------------------------------------------------------------------
// フォーム生成時の処理
//-----------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
//予め設定しておかないと,一番最初のビットマップが透過状態にならなかったので
ImageList1.BkColor := clFuchsia;
end;

//-----------------------------------------------------------------------------
// PopupMenuが表示された時のメッセージ処理
// マウスフックを開始する
//-----------------------------------------------------------------------------
procedure TForm1.WMEnterMenuLoop(var Message: TWMEnterMenuLoop);
begin
if hMouseHook = 0 then begin
hMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, 0, GetCurrentThreadID);
end;
//PopupMenu1のウィンドウハンドルを取得
//Windwosのポップアップメニューのクラス名は#32768
//32768は16進数に変換すると$8000
hPopupWnd := FindWindow('#32768', nil);
CurrentImgIndex := -1;
end;

//-----------------------------------------------------------------------------
// PopupMenuが閉じた時のメッセージ処理
// マウスフックを終了する
//-----------------------------------------------------------------------------
procedure TForm1.WMExitMenuLoop(var Message: TWMExitMenuLoop);
begin
if hMouseHook <> 0 then begin
UnhookWindowsHookEx(hMouseHook);
hMouseHook := 0;
end;
hPopupWnd := 0;
Panel1.Caption := '閉じた';
end;

//-----------------------------------------------------------------------------
// PopupMenu1のItem_0項目のOnAdvancedDrawItemイベント処理
// ImageListに格納してあるビットマップ画像を表示
// 本サンプルでは,Item_0(TMenuItem)が画像を表示するメニュー項目
//
// PopupMenu1のOwnerDrawプロパティをTrueにしておく
// ImageList1にビットマップ画像を4つ格納しておく
//-----------------------------------------------------------------------------
procedure TForm1.Item_0AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
var
aBitmap : TBitmap;
ItemWidth : Integer;
ItemHeigh : Integer;
DrawPos : TPoint;
RectImgPos : TPoint;
infMarginX : Integer;
infMarginY : Integer;
i : Integer;
RectDraw : TRect;
begin
if TMenuItem(Sender) = Item_0 then begin
ItemWidth := ImageList1.Width + 6;
ItemHeigh := ImageList1.Height + 6;

RectImgPos := PopupMenu1.PopupPoint;
Windows.ScreenToClient(hPopupWnd, RectImgPos);

aBitmap := TBitmap.Create;
try
infMarginX := 10;
infMarginY := 5;
InflateRect(ARect, -infMarginX, -infMarginY);

RectImgPos.X := PopupMenu1.PopupPoint.X + (ARect.Left - RectImgPos.X);
RectImgPos.Y := PopupMenu1.PopupPoint.Y + (ARect.Top - RectImgPos.Y);
DrawPos.X := ARect.Left;
DrawPos.Y := ARect.Top;

for i := 0 to Length(RectImage) - 1 do begin
//スクリーン座標値での描画領域
RectImage[i] := Rect(RectImgPos.X, RectImgPos.Y,
RectImgPos.X + ItemWidth,
RectImgPos.Y + ItemHeigh);

aBitmap.Assign(nil);
ImageList1.GetBitmap(i, aBitmap);
aBitmap.Transparent := True;

//クライアント座標値での描画領域
RectDraw := Rect(DrawPos.X, DrawPos.Y,
DrawPos.X + ItemWidth,
DrawPos.Y + ItemHeigh);
if i = CurrentImgIndex then begin
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := clMenuHighlight;
ACanvas.FillRect(RectDraw);
end else begin
ACanvas.Brush.Style := bsClear;
ACanvas.Brush.Color := clMenu;
ACanvas.FillRect(RectDraw);
end;

ACanvas.Draw(DrawPos.X + 3, DrawPos.Y + 3, aBitmap);
DrawPos.X := DrawPos.X + ItemWidth;
RectImgPos.X := RectImgPos.X + ItemWidth;
end;
finally
aBitmap.Free;
end;
end;
end;

//-----------------------------------------------------------------------------
// PopupMenu1のItem_0項目のOnMeasureItemイベント処理
// 項目の幅と高さを設定
//-----------------------------------------------------------------------------
procedure TForm1.Item_0MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
var
infMarginX : Integer;
infMarginY : Integer;
begin
//上のイベント内の定義と同じ値にする
infMarginX := 10;
infMarginY := 5;

//+5の値は上のイベントの設定したImageList1.Width + 5等と同じにする
Width := (ImageList1.Width + 5) * Length(RectImage) + infMarginX;
Height := ImageList1.Height + 5 + infMarginY * 2;
end;

//-----------------------------------------------------------------------------
// TMenuItemのItemのOnClickイベント処理
// 全てのItemの共有イベント
// 本サンプルでは,Item_0(TMenuItem)が画像を表示するメニュー項目
//-----------------------------------------------------------------------------
procedure TForm1.Item_0Click(Sender: TObject);
begin
if TMenuItem(Sender) = Item_0 then begin
//メニューをクリックした時は,画像のインデックスを表示
//実際には,取得した番号によって処理を分岐することになる
if CurrentImgIndex >= 0 then begin
ShowMessage(IntToStr(CurrentImgIndex + 1) + ' 番目の画像クリック');
end;
end;
end;

//-----------------------------------------------------------------------------
// ローカルマウスフックのメッセージを受信
// マウスカーソルの座標値を取得して表示
//-----------------------------------------------------------------------------
procedure TForm1.WMApp100(var Message: TMessage);
var
X : Integer;
Y : Integer;
aRect : TRect;
i : Integer;
Flags : Cardinal;
NewImgIndex : Integer;
begin
if hPopupWnd = 0 then exit;

X := LOWORD(Message.LParam);
Y := HIWORD(Message.LParam);

//PopupMen1のウィンドウの領域内の時だけ処理
GetWindowRect(hPopupWnd, aRect);
if PtInRect(aRect, Point(X, Y)) then begin
Panel1.Caption := 'X: ' + IntToStr(X) + ' Y: ' + IntToStr(Y);

//マウスカーソルの移動の場合
if Message.WParam = WM_MOUSEMOVE then begin
//どの画像の位置にマウスカーソルがあるか調べる
NewImgIndex := -1;
for i := 0 to Length(RectImage) - 1 do begin
if PtInRect(RectImage[i], Point(X, Y)) then begin
NewImgIndex := i;
break;
end;
end;

//画像のメニュー項目以外の場合は再描画しない
//マウスカーソルの移動の度に再描画すると,チラつくことになる
//マウスカーソルが別の画像に移動したら再描画する
if (NewImgIndex <> CurrentImgIndex) then begin
CurrentImgIndex := NewImgIndex;
Flags := RDW_INVALIDATE or RDW_UPDATENOW;
RedrawWindow(hPopupWnd, nil, 0, Flags);
end;
end;
end else begin
if hPopupWnd <> 0 then Panel1.Caption := '';
end;
end;


//-----------------------------------------------------------------------------
// PopupMenu内部のPopupListのメッセージ処理
// WM_ENTERMENULOOP : PopupMenuを表示した時のメッセージ
// WM_EXITMENULOOP : PopupMenuが閉じた時のメッセージ
// これらのメッセージを受信したら,アプリのアクティブなフォームにメッセージを送る
//-----------------------------------------------------------------------------

{ 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;
end;
inherited;
end;

initialization
Popuplist.Free;
PopupList:= TPopupListEx.Create;

end.
ページ: [1]
WP Forum Server by ForumPress | LucidCrew
バージョン: 1.7.5 ; ページロード: 0.022 sec.