Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2005.01.30;
Скачать: [xml.tar.bz2];

Вниз

Как программно отлавить наведение мыши на иконку на раб. столе?   Найти похожие ветки 

 
Ната   (2004-12-09 10:53) [0]

Пожалуйста, не могли бы Вы мне подсказать как программно отлавить событие наведение мыши на иконку на раб. столе?


 
Ната   (2004-12-09 11:55) [1]

ну хотя бы киньте ссылку где об этом точно можно найти..


 
Leonid Troyanovsky   (2004-12-09 12:30) [2]


> Ната   (09.12.04 10:53)  
> Пожалуйста, не могли бы Вы мне подсказать как программно
> отлавить событие наведение мыши на иконку на раб. столе?


Как сабклассировать чужое окно см тред:

http://delphimaster.net/view/4-1102135227/

Нужное окно - это SysListView32 "внук" Progman
находится, например, так:


function GetSysListView32: HWND;
begin
Result := FindWindow("Progman", nil);
Result := FindWindowEx(Result, 0, nil, nil);
Result := FindWindowEx(Result, 0, nil, nil);
end;


Нужное событие - это, видимо, определение кто под курсором
при WM_MOUSEMOVE (WindowFromPoint, LVM_GETITEMRECT).

--
С уважением, LVT.


 
Ната   (2004-12-09 13:59) [3]

а нет ли более простых путей?


 
Leonid Troyanovsky   (2004-12-09 14:29) [4]


> Ната   (09.12.04 13:59) [3]
> а нет ли более простых путей?


Можно без сабклассирования.
Попробуй SetWindowsHookEx WH_GETMESSAGE (в dll),
устанавливаемый на поток Explorer (где SysListView32).
На тот же WM_MOSEMOVE.

--
С уважением, LVT.


 
grom   (2004-12-09 19:20) [5]

программно отлавить наведение мыши на иконке своей программы?


 
Ната   (2004-12-10 09:43) [6]

не обязательно своей, на любой


 
grom   (2004-12-10 13:37) [7]

Если на своей иконке то можно так:
var sX, sY: Integer;
procedure TForm1.Ico(var M:TMessage);
begin
if M.WParam=1 then
case M.LParam of
WM_RBUTTONUP : PopupMenu1.Popup(Mouse.CursorPos.x,Mouse.CursorPos.y);
WM_MOUSEMOVE: begin
sX:= Mouse.CursorPos.x;
sY:= Mouse.CursorPos.y;
if Timer1.Enabled then exit;
Timer1.Enabled:=true;
Caption:="Mouse YES";
end;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (Mouse.CursorPos.x <> sX) or (Mouse.CursorPos.y <> sY) then begin
Caption:="Mouse NO";
Timer1.Enabled:=False;
end;
end;


 
Leonid Troyanovsky   (2004-12-10 14:33) [8]


> Ната   (10.12.04 09:43) [6]
> не обязательно своей, на любой


Ну, чего не получилось?
Держи:


library lib3;

uses
 Messages,
 Windows,
 commctrl;

var
 AHook: HHOOK;
 Caller : HWND;
 ListWnd: HWND;

function GetSysListView32: HWND;
begin
 Result := FindWindow("Progman", nil);
 Result := FindWindowEx(Result, 0, nil, nil);
 Result := FindWindowEx(Result, 0, nil, nil);
end;

function HookProc( nCode: Integer; wprm: WParam; lprm:WParam):LResult;
        stdcall;
type
 PMsg = ^TMsg;
var
 msg : PMsg;
 i, id: Longint;
 ARect : TRect;
begin
 msg := PMsg(lprm);

 case msg.Message of
   WM_NULL:
     if (msg.LParam <> 0) then
       begin
         AHook := msg.lParam;
         Caller := msg.wParam;
         ListWnd := GetSysListView32;
       end;
   WM_MOUSEMOVE:
     begin
       if msg.hwnd = ListWnd then
         begin
           id := -1;
           for i := 0 to ListView_GetItemCount(ListWnd)-1 do
             begin
               ListView_GetItemRect(ListWnd, i, ARect, LVIR_BOUNDS);
               if PtInRect(ARect, msg.pt) then
                 begin
                   id := i;
                   Break;
                 end;
             end;
            PostMessage(Caller, WM_USER, 0, id);
         end;
     end;
 end;
 Result := CallNextHookEx(AHook, ncode, wprm, lprm);
end;

var
 hhk: HHOOK;

procedure SetHook(Caller: HWND);
var
  tid: DWord;
  wnd: HWND;
begin
  wnd := GetSysListView32;
  tid := GetWindowThreadProcessId(wnd, nil);

  if hhk <> 0 then
    begin
      UnHookWindowsHookEx(hhk);
      PostThreadMessage(GetCurrentThreadID, 0, 0, 0);
    end;

  if Caller = 0 then
    Exit;

  hhk := SetWindowsHookEx(WH_GETMESSAGE, HookProc, Hinstance, tid);
  if hhk <> 0 then
    PostThreadMessage(tid, WM_NULL, Caller, hhk);
end;

exports
 SetHook;

begin

end.


Т.е., в главной форме делаешь пару кнопок
и наблюдаешь за Application.Title (внизу)


type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   procedure WMUser(var msg: TMessage); message WM_USER;
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure SetHook(wnd: HWnd); external "lib3.dll";

procedure TForm1.WMUser;
begin
 Application.Title := IntToStr(msg.LParam);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 SetHook(Handle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 SetHook(0);
end;


--
С уважением, LVT.



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2005.01.30;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.038 c
1-1105894004
slart
2005-01-16 19:46
2005.01.30
Подскажите компонент


1-1105679758
Nik8.
2005-01-14 08:15
2005.01.30
Почему функция неверно считает?


3-1104158542
Михаил2209
2004-12-27 17:42
2005.01.30
Вопрос Query выполняет запрос и показывает результат в DBGrid...


4-1102257133
Леонид
2004-12-05 17:32
2005.01.30
Отлов открытия папки файла!!!


3-1104147566
Garry_c
2004-12-27 14:39
2005.01.30
Вставка записей по одному запросу.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский