この発言に対し以下のコメントが寄せられています

#01154　雪見酒          さん　RE:デスクトップダブルクリックでポップア




nifty:FDELPHI/MES/8/11886以降のスレッドで話題になった、デスクトップで
のダブルクリックで、マウスメッセージをフックして、メニューをポップ
アップするサンプルです。ActiveDesktopには対応してません。どなたかハン
ドル取得の方法をご存知の方、フォローお願いします。

また、デスクトップ上のアイコンをダブルクリックしても、フックするのは悩
ましいところです。こちらもどなたかよろしく。m(_ _;)m
(ハンドルやHitTestCodeでは対応できません。）

なお、エラーには一切対応してません。エラー処理の方法は、
nifty:FDELPHI/LIB/16/113 トム猫さんのサンプルを参考にしてください。



//-------------------MousHook.dpr------------------------------------
library MouseHook;
uses
  SysUtils,Classes,MouseHookMain in 'MouseHookMain.pas';

{$R *.RES}
exports
  InstallHookProc,UnInstallHookProc;
begin
end.
//-------------------MouseHookMain.pas-------------------------------
unit MouseHookMain;

interface
Uses
   SysUtils,Classes,Windows,Messages,Dialogs;

type
  THostWnd = hWnd;
  PHostWnd = ^THostWnd;

function mouseProc(nCode:integer; wParam:integer;
                          lParam:LongInt):integer;stdcall;
function InstallHookProc(wnd:hWnd):integer;export;stdcall;
function UnInstallHookProc:integer;export;stdcall;

const
  uniqueString = 'MouseHookShareString';
  MyDblClkMsg = WM_USER+101;
  MyBtnDwnMsg = WM_USER+102;
var
   hShareMem:THandle;
   hndHook:HHook;
implementation

function mouseProc(nCode:integer; wParam:integer; lParam:LongInt)
                                                :integer;stdcall;
//mouseHook のコールバック関数
var
  ptr: pointer;
  hDskTop:hWnd;
begin
  if nCode = HC_ACTION then begin
    //シェアメモリへアクセス
    ptr := MapViewOfFile(hShareMem, FILE_MAP_ALL_ACCESS, 0, 0, 0);
    // デスクトップのハンドル取得、ActiveDesktop は未対応(^^;
    hDskTop := FindWindow('Progman', nil);
    hDskTop := FindWindowEx(hDskTop, 0, 'SHELLDLL_DefView', nil);
    hDskTop := FindWindowEx(hDskTop, 0, 'SysListView32', nil);
    if wParam = WM_LBUTTONDOWN then
      PostMessage(PHostWnd(ptr)^, MyBtnDwnMsg, 0, 0);
    if          (hDskTop = PMouseHookStruct(lParam).hwnd) and
                              (wParam = WM_LBUTTONDBLCLK) then
      PostMessage(PHostWnd(ptr)^, MyDblClkMsg, 0, 0);
    //アクセス終了
    UnmapViewOfFile(ptr) ;
    result:=0;  //システムに戻す。メッセ−ジを破棄する場合は0以外
  end else
    //次のHookへMessageを渡す
  result := CallNextHookEx(hndHook, nCode, wParam, lParam);
end;

function InstallHookProc(wnd: hWnd):integer; stdcall;
//Hookをインストール
var
  ptr:pointer;
begin
  //シェアメモリへアクセス
  ptr := MapViewOfFile(hShareMem, FILE_MAP_ALL_ACCESS, 0,0,0);
  PHostWnd(ptr)^:=wnd;
  HndHook := SetWindowsHookEx(WH_MOUSE,@mouseProc,hInstance,0);
  UnmapViewOfFile(ptr);  //アクセス終了
  Result := HndHook;
end;

function UnInstallHookProc:integer;
//Hookのアンインストール
begin
  if UnHookWindowsHookEx(HndHook) then
  result:= 0 else result:=-1;
end;

initialization
// シェアメモリ確保
begin
   hShareMem := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,
                                   0,SizeOf(THostWnd),UniqueString);
end;

finalization
//シェアメモリ開放
begin
  if hShareMem = 0 then exit;
  CloseHandle(hShareMem);
end;

end.
//------------------------Unit1.pas----------------------------------
//プロジェクトはフォームと、メニューだけ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
  Menus;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    N11: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    procedure WMMyDblClk(var Message:TMessage);message WM_USER+101;
    procedure WMMyBtnDwn(var Message:TMessage);message WM_USER+102;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

function InstallHookProc(wnd:
hWnd):integer;stdcall;external'MouseHook.dll';
function UnInstallHookProc:integer;stdcall;external'MouseHook.dll';

var
  Form1: TForm1;

implementation

{$R *.DFM}
procedure TForm1.WMMyDblClk(var Message:TMessage);
begin
  PopupMenu1.Popup(100,100);//ポップアップする場所はお好きなように
end;

procedure TForm1.WMMyBtnDwn(var Message:TMessage);
// ポップアップメニューの消去
begin
  PostMessage(PopupMenu1.WindowHandle,WM_LBUTTONDOWN,0,0);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnInstallHookProc;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InstallHookProc(Form1.Handle);
end;

end.
                                 Yukimi Sake GHE01746@nifty.ne.jp
 



Original document by 雪見酒          氏 ID:(GHE01746)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。