Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2008年04月13日] [更新 2013年09月29日]　Delphi サンプルプログラム集
261_マウスカーソル位置に画像を表示
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
261_HookMouseEvent01.zip　[1,717 KB]　2013年09月21日版 (EXE 同梱)



  • 2009年07月27日
  • コールバックの戻り値 (Result) を CallNextHookEx の戻り値とした
  • 2010年08月23日
  • ポップアップメニューの後ろに画像が隠れてしまう現象を修正
  • グローバルマウスフックとキーフックの DLL を使用するコードに変更
    (WH_JOURNALRECORD が Windows Vista 以降では機能しないため)
  • 2010年08月24日
  • DLL を使用しない低レベルのマウスフックを利用したサンプルコードを追加
  • 2013年09月21日
  • サンプル [01] に，UIPI (ユーザーインターフェイス特権の分離) 対応コードを追加
  • 複数のカーソルを定義して，切り替えて使用する方法のコードを追加



01_マウスカーソル位置に画像を表示  -  WH_MOUSE フック使用


グローバルフックを使用して，マウスの位置に画像を表示するようにしたサンプルです．
このサンプルは，マウスとキーのグローバルフックのサンプルを変更修正して作成しました．
フックを開始すると，アクティブな，入力フォーカスがあるウィンドウのキャプションと，マウス位置の座標を表示します．マウスカーソル位置に画像を置いたフォームを表示します．このフォームは透明化していて，実行時には画像しか表示しません．

UIPI (ユーザーインターフェイス特権の分離) 対応コードについては，[ドラッグ・アンド・ドロップ機能の実装 (Vista 以降の UIPI 対応)] 記事も参考にしてください．


[備考]
管理者権限で起動しているアプリのウインドウ内では，フックが無効になることがあります．その場合は，本サンプルを管理者権限で実行してください．


図1
設計時画面 1
  • メインフォーム
図2
設計時画面 2
  • 画像用のフォーム
  • 実行時にはフォームは透明
図3
実行画面
  • マウスカーソル位置にカエルの画像

リスト1
マウスカーソル位置に画像を表示 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Panel2: TPanel;
    Panel3: TPanel;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DisplayKeyCodeMousePos(hWindow: HWND; MsgStr: String;
      Int1,Int2: Integer);
    function GetWindowTextStr(hWindow:HWND):String;
  protected
    procedure WMApp100(var Message: TMessage); message WM_APP+100;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses KaeruUnit;

{$R *.DFM}

function StartMouseHook(Wnd: HWND): HHOOK; stdcall; external 'PLMOUSEHOOK.DLL';
procedure StopMouseHook; stdcall; external 'PLMOUSEHOOK.DLL';

var
  Hook : HHOOK;

//=============================================================================
//  ListViewの各カラムを設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.ViewStyle := vsReport;

  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' アクティブウィンドのタイトル';
  ListView1.Columns[0].Width   := 218;

  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := ' EVENT';
  ListView1.Columns[1].Width   := 90;
end;

//=============================================================================
//  アプリ終了時はフック関数をアンインストール(登録解除)
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(KaeruForm);
  UnhookWindowsHookEx(Hook);
end;

//=============================================================================
//  フック関数をインストール(登録)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  //  Microsoft Windows SDK 7.1 より抜粋
  //  * Message Filter
  //  #define MSGFLT_ADD 1
  //  #define MSGFLT_REMOVE 2
  MSGFLT_ADD    = 1;
  MSGFLT_REMOVE = 2;
var
  DLLHandle  : THandle;
  FuncFilter : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
begin
  //UIPI(ユーザーインターフェイス特権の分離)対応処理
  //このプログラムを管理者権限で実行してもWM_APP+100メッセージの受信を可能にする
  if CheckWin32Version(6, 0) then begin
    DLLHandle := loadLibrary('user32.dll');
    try
      if DLLHandle > 0 then begin
        @FuncFilter := GetProcAddress(DLLHandle, 'ChangeWindowMessageFilter');
        if @FuncFilter <> nil then begin
          FuncFilter(WM_APP+100, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(DLLHandle);
    end;
  end;

  StartMouseHook(Handle);

  if KaeruForm = nil then KaeruForm := TKaeruForm.Create(Self);
  KaeruForm.Show;

  ListView1.Items.Clear;
end;

//=============================================================================
//  フック関数をアンインストール(登録解除)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Windows.BringWindowToTop(GetActiveWindow);
  KaeruForm.Close;
  StopMouseHook;
end;

//-----------------------------------------------------------------------------
//  DLLからグローバルフックしたマウス情報を受取る
//-----------------------------------------------------------------------------
procedure TForm1.WMApp100(var Message: TMessage);
var
  LhTarger  : HWND;
  LMsgStr   : String;
  LMousePos : TPoint;
begin
  case Message.WParam of
    WM_NCMOUSEMOVE:   LMsgStr := 'NCMouseMove';
    WM_NCLBUTTONDOWN: LMsgStr := 'NCLButtonDown';
    WM_NCLBUTTONUP:   LMsgStr := 'NCLButtonUp';
    WM_NCRBUTTONDOWN: LMsgStr := 'NCRButtonDown';
    WM_NCRBUTTONUP:   LMsgStr := 'NCRButtonUp';
    WM_MOUSEMOVE:     LMsgStr := 'MouseMove';
    WM_LBUTTONDOWN:   LMsgStr := 'LButtonDown';
    WM_LBUTTONUP:     LMsgStr := 'LButtonUp';
    WM_RBUTTONDOWN:   LMsgStr := 'RButtonDown';
    WM_RBUTTONUP:     LMsgStr := 'RButtonUp';
  end;

  LhTarger := GetForegroundWindow;
  if LhTarger <> 0 then begin
    GetCursorPos(LMousePos);
    //アクティブウィンドウのタイトルと操作内容をListViewに表示
    Form1.DisplayKeyCodeMousePos(LhTarger, LMsgStr, LMousePos.X, LMousePos.Y);
  end;
end;

//-----------------------------------------------------------------------------
//  ウィンドウのタイトルと操作内容をListViewに表示
//  また，マウス座標値を表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayKeyCodeMousePos(hWindow: HWND; MsgStr: String;
  Int1, Int2: Integer);
var
  LItem      : TListItem;
  LTargetWnd : HWND;
begin
  if MsgStr = '' then exit;

  LItem := ListView1.Items.Add;

  //現在入力フォーカスのあるウィンドウ
  LTargetWnd := Handle;
  if (hWindow <> Handle) then begin
    //マウスカーソルと共に表示する画像(フォーム)を最前面に
    Windows.BringWindowToTop(KaeruForm.Handle);
    LTargetWnd := hWindow;
  end;

  LItem.Caption := GetWindowTextStr(LTargetWnd);
  LItem.SubItems.Add(MsgStr);

  //ListViewの一番最後を表示
  ListView1.Items[ListView1.Items.Count-1].Selected := True;
  ListView1.Items[ListView1.Items.Count-1].Focused  := True;
  ListView1.Items[ListView1.Items.Count-1].MakeVisible(True);

  Panel2.Caption := Format('[ X=%.4d Y=%.4d ]',[Int1,Int2]);

  //Int1はX座標値．Int2はY座標値
  KaeruForm.Left := Int1 + 1;
  KaeruForm.Top  := Int2 + 1;
  //ここでマウスの操作状態で画像を変更することも可能
  //最初からアニメーション(gif画像)等を使用すれば面白いかも
end;

//-----------------------------------------------------------------------------
//  対象のウィンドウハンドルhWindowからそのタイトル(キャプション)を取得
//-----------------------------------------------------------------------------
function TForm1.GetWindowTextStr(hWindow: HWND): String;
var
  Buff : array [0..MAX_PATH-1] of Char;
begin
  FillChar(Buff, MAX_PATH, #0);
  GetWindowText(hWindow, Buff, GetWindowTextLength(hWindow) + 1);
  Result := String(Buff);
end;

end.


リスト2
画像表示用フォームのコード 
unit KaeruUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TKaeruForm = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  private
    { Private 宣言 }                                                
  public
    { Public 宣言 }
  end;

var
  KaeruForm: TKaeruForm;

implementation

{$R *.dfm}

//=============================================================================
//  ウィンドウスタイルの変更
//
//  メインフォームのFormStyleはfsStayOnTop
//  このフォームの設定は以下の通り
//  FormStyle   := fsNormal;
//  BorderStyle := bsNone;
//=============================================================================
procedure TKaeruForm.CreateParams(var Params: TCreateParams);
begin
  inherited;

  //前面に表示
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST;
end;

//=============================================================================
//  以下はオブジェクト・インスペクタで設定するのが良
//  TransparentColorはデフォルトのclBtnfaceでは無効なので他の色に変更
//=============================================================================
procedure TKaeruForm.FormCreate(Sender: TObject);
begin
  Self.Color := clSkyBlue;
  Self.TransparentColor := True;
  Self.TransparentColorValue := Self.Color;
end;

end.


リスト3
マウスフックDLLのプロジェクトファイル 
library plMouseHook;

uses
  plMouseHookUnit in 'plMouseHookUnit.pas';

//-----------------------------------------------------------------------------
//  外部からDLL内のメソッドを利用可能にするためのオマジナイ
//-----------------------------------------------------------------------------
exports
  StartMouseHook,
  StopMouseHook;
end.


リスト4
マウスフック DLL のコード 
unit plMouseHookUnit;

interface

uses
  Windows, Messages, SysUtils;

//外部のアプリケーションから使用する関数類
function StartMouseHook(Wnd: HWND): Boolean; stdcall;
procedure StopMouseHook; stdcall;

implementation

//共有メモリの内容の構造体
type
  PHookInfo  = ^THookInfo;
  THookInfo  = record
  HookHandle : HHOOK;
  HostWnd    : HWND;
end;

var
  //メモリマップドファイルのハンドル
  hMapFile : THandle;

const
  //メモリマップドファイル名
  MapFileName = 'plMouseHookDLL';

//-----------------------------------------------------------------------------
//  共有メモリアクセスのための準備
//
//  成功すると0を返す.失敗すると負数を返す.
//  負の値で処理を分岐できるようになっているが,このコードでは未使用.
//-----------------------------------------------------------------------------
function MapFileMemory(var hMap: THandle; var pMap: pointer): Integer;
begin
  //メモリマップドファイルを開く
  hMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, MapFileName);
  if hMap = 0 then begin
    Result := -1;
    exit;
  end;

  //メモリマップドファイルの割り当て
  pMap := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if pMap = nil then begin
    Result := -2;
    CloseHandle(hMap);
    exit;
  end;

  Result := 0;
end;

//-----------------------------------------------------------------------------
//  共有メモリアクセスの後始末
//  割当てたメモリがあればビューを解除
//  ハンドルがあればクローズ
//-----------------------------------------------------------------------------
procedure UnMapFileMemory(hMap: THandle; pMap: Pointer);
begin
  if pMap <> nil then UnmapViewOfFile(pMap);
  if hMap <> 0 then CloseHandle(hMap);
end;

//-----------------------------------------------------------------------------
//  フックのコールバック関数
//  このDLLを使用したアプリにメッセージを送る
//-----------------------------------------------------------------------------
function MouseHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM):
  LRESULT; stdcall;
var
  LpMap   : Pointer;
  LMapWnd : THANDLE;
begin
  Result := 0;
  if MapFileMemory(LMapWnd, LpMap) <> 0 then exit;

  if nCode < 0 then begin
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end else begin
    if nCode = HC_ACTION then begin
      PostMessage(pHookInfo(LpMap)^.HostWnd, WM_APP+100, wPar, lPar);
    end;
    Result := CallNextHookEx(pHookInfo(LpMap)^.HookHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LMapWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  フック関数の登録
//-----------------------------------------------------------------------------
function StartMouseHook(Wnd: HWND): Boolean; stdcall;
var
  LpMap   : Pointer;
  LMapWnd : THandle;
begin
  Result := False;


  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap = nil then begin
    LMapWnd := 0;
    exit;
  end;

  //フック情報構造体初期化とフック関数の登録
  pHookInfo(LpMap)^.HostWnd := Wnd;
  //フックをインストール
  pHookInfo(LpMap)^.HookHandle := SetWindowsHookEx(WH_MOUSE,
                                               Addr(MouseHookProc),
                                               hInstance,
                                               0);
  //フック成功
  if pHookInfo(LpMap)^.HookHandle > 0 then begin
    Result := True;
  end;
  //メモリマップドファイル使用終了処理
  UnMapFileMemory(LMapWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  フックの解除
//-----------------------------------------------------------------------------
procedure StopMouseHook; stdcall;
var
  LpMap   : Pointer;
  LMapWnd : THandle;
begin
  //メモリマップドファイル使用準備
  MapFileMemory(LMapWnd, LpMap);
  if LpMap = nil then begin
    LMapWnd := 0;
    exit;
  end;

  //フック解除
  if pHookInfo(LpMap)^.HookHandle > 0 then begin
    UnhookWindowsHookEx(pHookInfo(LpMap)^.HookHandle);
  end;

  //メモリマップドファイル使用終了処理
  UnMapFileMemory(LMapWnd, LpMap);
end;

//-----------------------------------------------------------------------------
//  ユニット初期化部
//  メモリマップドファイルの作成
//
//  High(NativeUInt)の値は
//  32ビットアプリでは$FFFFFFFF
//  64ヒットアプリでは$FFFFFFFFFFFFFFFF
//-----------------------------------------------------------------------------
initialization
begin
  hMapFile := CreateFileMapping(High(NativeUInt),
                                nil,
                                PAGE_READWRITE,
                                0,
                                SizeOf(THookInfo),
                                MapFileName);
end;

//-----------------------------------------------------------------------------
//  ユニット終了処理部
//  メモリマップドファイルのクローズ
//-----------------------------------------------------------------------------
finalization
begin
  if hMapFile<>0 then CloseHandle(hMapFile);
end;

end.



02_WH_MOUSE フックにおけるマウスカーソル位置の取得


上のサンプルでは，マウスカーソルの位置を GetCursorPos 関数で取得しています．
フックのコールバック関数内でマウスカーソル位置を取得して，受信側で受け取るようにすることもできます．それには，マウスフックの情報を格納している構造体 (レコード型) からマウスカーソル位置を取得します．
次のコードでは，PostMessage の LParam パラメータの上位ワードと下位ワードにマウスカーソルの座標値を格納しています．		 


//-----------------------------------------------------------------------------
//  フックのコールバック関数
//  このDLLを使用したアプリにメッセージを送る
//
//  マウスカーソル位置をlParamの下位ワード，上位ワードに格納
//-----------------------------------------------------------------------------
function MouseHookProc(nCode: Integer; wPar: WPARAM; lPar: LPARAM):
  LRESULT; stdcall;
var
  LpMap     : Pointer;
  LMapWnd   : THANDLE;
  LMousePos : TPoint;
begin
  Result := 0;
  if MapFileMemory(LMapWnd, LpMap) <> 0 then exit;

  if nCode < 0 then begin
    Result := CallNextHookEx(pHookInfo(p)^.HookHandle, nCode, wPar, lPar);
  end else begin
    if nCode = HC_ACTION then begin
      LMousePos := PMouseHookStruct(lPar)^.pt;
      PostMessage(pHookInfo(p)^.HostWnd,
                  WM_APP+100,
                  wPar,
                  MakeLParam(LMousePos.X, LMousePos.Y));
    end;
    Result := CallNextHookEx(pHookInfo(p)^.HookHandle, nCode, wPar, lPar);
  end;

  UnMapFileMemory(LMapWnd, LpMap);
end;


受信側では，次のように，LParam の下位ワードから X 座標値，上位ワードから Y 座標値を取り出すことができます． 


  LhTarget := GetForegroundWindow;
  if LhTarget <> 0 then begin
    //マウスカーソルのスクリーン座標値を取得
    X := LOWORD(Message.LParam);
    Y := HIWORD(Message.LParam);
    //アクティブウィンドウのタイトルと操作内容をListViewに表示
    Form1.DisplayKeyCodeMousePos(LhTarget, LMsgStr, X, Y);
  end;



03_マウスカーソル位置に画像を表示  -  WH_MOUSE_LL フック使用


低レベルのマウスフックである WH_MOUSE_LL を使用したサンプルです．フック開始時に引数等を使用する必要がなければこの方法が利用できます．低レベルマウスフックは DLL にしなくてもグローバルフックを実現できます．構造体の説明は MSDN オンイランにあります．
前のサンプルとは，カエルの画像表示のタイミングが微妙に違います．ポップアップメニューを表示した直後，少しマウスを移動しないと表に表示されないようです．メッセージが，WH_MOUSE フックよりも前にこの低レベルのフックを通過するためと思われます．


リスト5
WH_MOUSE_LL を使用したコード
このメインフォーム以外のコードは全て同じ 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Panel2: TPanel;
    Panel3: TPanel;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    procedure DisplayKeyCodeMousePos(hWindow: HWND; MsgStr: String;
      Int1,Int2: Integer);
    function GetWindowTextStr(hWindow:HWND):String;
  protected
    procedure WMApp100(var Message: TMessage); message WM_APP+100;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses KaeruUnit;

{$R *.DFM}

//-----------------------------------------------------------------------------
//  低レベルマウスフックの情報構造体と定数
//  LLMHF_INJECTEDはマウスフックで使用
//-----------------------------------------------------------------------------
const
  LLMHF_INJECTED = $00000001;

type
  LPMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;
  tagMSLLHOOKSTRUCT = record
    pt: TPOINT;
    mouseData: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: ULONG_PTR;
  end;
  MSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;
  TMsllHookStruct = MSLLHOOKSTRUCT;
  PMsllHookStruct = LPMSLLHOOKSTRUCT;

var
  MouseHookHandle : HHOOK;

//-----------------------------------------------------------------------------
//  マウスフックのコールバック関数
//-----------------------------------------------------------------------------
function LowLevelMouseProc(Code: Integer; wPar: WPARAM; lPar: LPARAM):
  LRESULT; stdcall;
begin
  if Code < 0 then begin
    Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
    exit;
  end;

  if Code = HC_ACTION then begin
    PostMessage(Form1.Handle, WM_APP+100, wPar, 0);
  end;

  Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
end;

//=============================================================================
//  ListViewの各カラムを設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.ViewStyle := vsReport;

  ListView1.Columns.Add;
  ListView1.Columns[0].Caption := ' アクティブウィンドのタイトル';
  ListView1.Columns[0].Width   := 218;

  ListView1.Columns.Add;
  ListView1.Columns[1].Caption := ' EVENT';
  ListView1.Columns[1].Width   := 90;
end;

//=============================================================================
//  アプリ終了時はフック関数をアンインストール(登録解除)
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(KaeruForm);

  if MouseHookHandle <> 0 then begin
    UnhookWindowsHookEx(MouseHookHandle);
    MouseHookHandle := 0;
  end;
end;

//=============================================================================
//  フック関数をインストール(登録)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //マウスフック開始
  if MouseHookHandle = 0 then
    MouseHookHandle := SetWindowsHookEx(WH_MOUSE_LL,
                                        @LowLevelMouseProc,
                                        hInstance,
                                        0);
  if KaeruForm = nil then KaeruForm := TKaeruForm.Create(Self);

  ListView1.Items.Clear;
end;

//=============================================================================
//  フック関数をアンインストール(登録解除)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Windows.BringWindowToTop(GetActiveWindow);
  KaeruForm.Close;

  if MouseHookHandle <> 0 then begin
    UnhookWindowsHookEx(MouseHookHandle);
    MouseHookHandle := 0;
  end;
end;

//-----------------------------------------------------------------------------
//  グローバルフックしたマウス情報を受取る
//-----------------------------------------------------------------------------
procedure TForm1.WMApp100(var Message: TMessage);
var
  LhTarget  : HWND;
  LMsgStr   : String;
  LMousePos : TPoint;
begin
  case Message.WParam of
    WM_NCMOUSEMOVE     : LMsgStr := 'NC_MouseMove';
    WM_NCLBUTTONDOWN   : LMsgStr := 'NC_LButtonDown';
    WM_NCLBUTTONUP     : LMsgStr := 'NC_LButtonUp';
    WM_NCLBUTTONDBLCLK : LMsgStr := 'NC_LButtonDBLClick';
    WM_NCRBUTTONDOWN   : LMsgStr := 'NC_RButtonDown';
    WM_NCRBUTTONUP     : LMsgStr := 'NC_RButtonUp';
    WM_NCRBUTTONDBLCLK : LMsgStr := 'NC_RButtonDBLClick';
    WM_NCMBUTTONDOWN   : LMsgStr := 'NC_MButtonDown';
    WM_NCMBUTTONUP     : LMsgStr := 'NC_MButtonUp';
    WM_NCMBUTTONDBLCLK : LMsgStr := 'NC_MButtonDBLClick';

    WM_MOUSEMOVE       : LMsgStr := 'MouseMove';
    WM_LBUTTONDOWN     : LMsgStr := 'LButtonDown';
    WM_LBUTTONUP       : LMsgStr := 'LButtonUp';
    WM_LBUTTONDBLCLK   : LMsgStr := 'LButtonDBLClick';

    WM_RBUTTONDOWN     : LMsgStr := 'RButtonDown';
    WM_RBUTTONUP       : LMsgStr := 'RButtonUp';
    WM_RBUTTONDBLCLK   : LMsgStr := 'RButtonDBLClick';

    WM_MBUTTONDOWN     : LMsgStr := 'MButtonDown';
    WM_MBUTTONUP       : LMsgStr := 'MButtonUp';
    WM_MBUTTONDBLCLK   : LMsgStr := 'MButtonDBLClick';
    WM_MOUSEWHEEL      : LMsgStr := 'MouseWheel';
    WM_MOUSEHWHEEL     : LMsgStr := 'MouseHWheel';
  else
    begin
      LMsgStr := Format(' $%.2x', [Message.WParam]);
    end;
  end;

  LhTarget := GetForegroundWindow;
  if LhTarget <> 0 then begin
    GetCursorPos(LMousePos);
    //アクティブウィンドウのタイトルと操作内容をListViewに表示
    Form1.DisplayKeyCodeMousePos(LhTarget, LMsgStr, LMousePos.X, LMousePos.Y);
  end;
end;

//-----------------------------------------------------------------------------
//  ウィンドウのタイトルと操作内容をListViewに表示
//  また，マウス座標値を表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayKeyCodeMousePos(hWindow: HWND; MsgStr: String;
  Int1, Int2: Integer);
var
  LItem      : TListItem;
  LTargetWnd : HWND;
begin
  if MsgStr = '' then exit;

  LItem := ListView1.Items.Add;

  if (hWindow = Handle) then begin
    LTargetWnd := Handle;
  end else begin
    //マウスカーソルと共に表示する画像(フォーム)を最前面に
    Windows.BringWindowToTop(KaeruForm.Handle);
    LTargetWnd := hWindow;
  end;

  LItem.Caption := GetWindowTextStr(LTargetWnd);
  LItem.SubItems.Add(MsgStr);

  //ListViewの一番最後を表示
  ListView1.Items[ListView1.Items.Count-1].Selected := True;
  ListView1.Items[ListView1.Items.Count-1].Focused  := True;
  ListView1.Items[ListView1.Items.Count-1].MakeVisible(true);

  Panel2.Caption := Format('[ X=%.4d Y=%.4d ]',[Int1,Int2]);

  //Int1はX座標値．Int2はY座標値
  KaeruForm.Left := Int1 + 1;
  KaeruForm.Top  := Int2 + 1;
  if KaeruForm.Visible = False then KaeruForm.Show;
end;

//-----------------------------------------------------------------------------
//  対象のウィンドウハンドルhWindowからそのタイトル(キャプション)を取得
//-----------------------------------------------------------------------------
function TForm1.GetWindowTextStr(hWindow: HWND): String;
var
  Buff : array [0..MAX_PATH-1] of Char;
begin
  FillChar(Buff, MAX_PATH, #0);
  GetWindowText(hWindow, Buff, GetWindowTextLength(hWindow) + 1);
  Result := String(Buff);
end;

end.



04_WH_MOUSE_LL フックにおけるマウスカーソル位置の取得


上のサンプルでは，マウスカーソルの位置を GetCursorPos 関数で取得しています．
フックのコールバック関数内でマウスカーソル位置を取得して，受信側で受け取るようにすることもできます．それには，マウスフックの情報を格納している構造体 (レコード型) からマウスカーソル位置を取得します．
次のコードでは，PostMessage の LParam パラメータの上位ワードと下位ワードにマウスカーソルの座標値を格納しています．		 


//-----------------------------------------------------------------------------
//  マウスフックのコールバック関数
//
//  マウスカーソル位置をlParamの下位ワード，上位ワードに格納
//-----------------------------------------------------------------------------
function LowLevelMouseProc(Code: Integer; wPar: WPARAM; lPar: LPARAM):
  LRESULT; stdcall;
var
  LMousePos : TPoint;
begin
  if Code < 0 then begin
    Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
    exit;
  end;

  if Code = HC_ACTION then begin
    LMousePos := PMsllHookStruct(lPar)^.pt;
    PostMessage(Form1.Handle, WM_APP+100, wPar, MakeLParam(MousePos.X, MousePos.Y));
  end;

  Result := CallNextHookEx(MouseHookHandle, Code, wPar, lPar);
end;


受信側では，次のように，LParam の下位ワードから X 座標値，上位ワードから Y 座標値を取り出すことができます． 


  LhTarget := GetForegroundWindow;
  if LhTarget <> 0 then begin
    //マウスカーソルのスクリーン座標値を取得
    X := LOWORD(Message.LParam);
    Y := HIWORD(Message.LParam);
    //アクティブウィンドウのタイトルと操作内容をListViewに表示
    Form1.DisplayKeyCodeMousePos(LhTarget, LMsgStr, X, Y);
  end;



05_システムのマウスカーソルを変更


もし，システム全体でマウスカーソルの形状を変更するのであれば，次のリストのようにカーソルの関数の API 関数，SetSystemCursor を使用します．[110_OnMouseMove イベントを使用したコントロールのドラッグ] のサンプルのように，独自のマウスカーソルを定義して使用することもできます．
本サンプルで使用している SyetemParametersInfo 関数は，特にユーザインターフェイス関係の設定や取得ができます．


図4
変更前
図5
変更後のマウスカーソル

リスト6
システムのマウスカーソル (ポインタ) 変更する例		 
unit ChangeMouseCursorUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  元に戻しておかないと変更されたまま
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETCURSORS, 0, nil, 0);
end;

//=============================================================================
//  システム全体のマウスカーソル形状を変更
//  マウスカーソルファイルから読出して設定
//
//  SystemCursorの最後の引数に指定する元のマウスカーソルの値
//
//  OCR_NORMAL      通常の選択カーソル
//  OCR_IBEAM       I型カーソル
//  OCR_WAIT        大きい砂時計カーソル
//  OCR_CROSS       十字カーソル
//  OCR_UP          上向き矢印カーソル
//  OCR_SIZE        サイズ変更カーソル
//  OCR_ICON        アイコン カーソル
//  OCR_SIZENWSE    左上から右下方向のサイズ変更カーソル
//  OCR_SIZENESW    右上から左下方向のサイズ変更カーソル
//  OCR_SIZEWE      水平方向サイズ変更カーソル
//  OCR_SIZENS      垂直方向サイズ変更カーソル
//  OCR_SIZEALL     水平および垂直方向サイズ変更カーソル
//  OCR_SIZENO      各国対応の記号なしカーソル
//  OCR_APPSTARTING 矢印付きの小さい砂時計カーソル
//  OCR_HAND        リンク選択カーソル
//
//  Delphi ML 81301からのツリー参照
//  http://www2.big.or.jp/~osamu/Delphi/delphi-browse.cgi?index=081320
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
 CurPath1 : String;
 CurPath2 : String;
 CurPath3 : String;
begin
  //各カーソル画像のパス名
  CurPath1 := 'Cursor1.cur';
  CurPath2 := 'C:\Windows\Cursors\metronom.ani';
  CurPath3 := 'harrow.cur';

  //通常の選択カーソルを変更
  SetSystemCursor(LoadCursorFromFile(PChar(CurPath1)), OCR_NORMAL);

  //矢印付きの小さい砂時計カーソルを変更
  SetSystemCursor(LoadCursorFromFile(PChar(CurPath2)), OCR_APPSTARTING);

  //ブラウザでリンク上にきた時のマウスを変更
  SetSystemCursor(LoadCursorFromFile(PChar(CurPath3)), OCR_HAND);

  //不要のようだ
  //SystemParametersInfo(SPI_SETCURSORS,0,NULL,WM_SETTINGCHANGE);
end;

//=============================================================================
//  まとめて元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  SystemParametersInfo(SPI_SETCURSORS, 0, nil, 0);
end;

end.


マウスカーソルは，次のようにして，複数のカーソルを登録しておいて，実行時に切り替えて使用することもできます． 


procedure TForm1.Button1Click(Sender: TObject);
const
  crMyCursor = 1;
begin
  //Cursor1.curファイルのカーソルをcrMyCursorに割り当てる
  Screen.Cursors[crMyCursor] := LoadCursorFromFile('Cursor1.cur');
  //実際に利用
  Screen.Cursor := crMyCursor;
end;



06_メタファイルが不正です


このページのサンプルで使用している「カエル」の画像はメタファイルです．
TImage の Picture プロパティに代入する際，wmf 形式は「メタファイルが不正です」のエラーが発生することがあります．または実行時にエラーが発生し，終了すると画像が消失することがあります．そのような場合は，以下のコードで拡張メタファイルに変換するとうまくいくことがあります．


図6
メタファイルが不正です

リスト7
拡張メタファイルに変換 
procedure TForm1.Button1Click(Sender: TObject);
var
  MetaFile: TMetaFile;
begin
  MetaFile := TMetaFile.Create;
  MetaFile.LoadFromFile('E_frog.wmf');
  MetaFile.Enhanced := True;
  MetaFile.SaveToFile('E_frog.emf');
  MetaFile.Free;
end;