Re[4]: Найти иконку в трее
Здравствуйте, AleX.
>> Был бы Вам очень признателен за этот проект. Вообще-то, я нашел пример
>> на С++ и переделал его на Делфу. Получилось такое:
A> вместо A> GetMem(p, 255);
A> должно быть A> p := VirtualAllocEx(hpr, nil, 255, MEM_COMMIT or MEM_RESERVE,
A> PAGE_READWRITE);
A> и т.д. Уже, в принципе, все работает - просто при переводе с С запутался в
переменных. То есть, в цикле обходится все иконки трея, возвращаются
координаты их прямоугольников.
Теперь вопрос, как определить, нужная ли это иконка. Думаю сделать это
по текстам ярлыков. Но опять запутался с методикой посылки сообщения.
Делаю так:
var
hShellTray, hTrayNotify, hTrayToolBar, hSysPager :HWND;
hBalloon, dProcess, dThread :HWND;
hpr,cwd :HWND;
dTrayProcess, dTrayThread :DWORD;
nButtons,i :Integer;
bt :TTBBUTTON;
mBt :Pointer;
mRect :^TRect;
rcTrayIcon :TRect;
RBytes :DWORD;
p :PChar;
hTrayBalloon, hTrayToolTip, hTrayProcess :HWND;
TInfo :^TOOLINFO;
begin
hShellTray := FindWindow('Shell_TrayWnd',0);
hTrayNotify := FindWindowEx(hShellTray,0,'TrayNotifyWnd',0);
hSysPager := FindWindowEx(hTrayNotify,0,'SysPager',0);
hTrayToolBar := FindWindowEx(hSysPager,0,'ToolbarWindow32',0);
dTrayThread := GetWindowThreadProcessId(hTrayToolBar, dTrayProcess);
hBalloon := FindWindowEx(0, 0, TOOLTIPS_CLASS, 0);
while BOOL(hBalloon) do
begin
dThread := GetWindowThreadProcessId(hBalloon, @dProcess);
if (dThread = dTrayThread) and (dProcess = dTrayProcess) then
begin
if BOOL(GetWindowLong(hBalloon, GWL_STYLE){ and TTS_BALLOON}) then
begin
hTrayBalloon := hBalloon;
if hTrayToolTip > 0 then
Break;
end;
if GetWindowLong(hBalloon, GWL_STYLE) and TTS_NOPREFIX = 0 then
begin
hTrayToolTip := hBalloon;
if hTrayBalloon > 0 then
Break;
end;
end;
hBalloon := FindWindowEx(0, hBalloon, TOOLTIPS_CLASS, 0);
end;
...........................................................
GetMem(p, 255);
nButtons := SendMessage(hTrayToolBar, TB_BUTTONCOUNT, 0, 0);
for i := 0 to nButtons-1 do
begin
ZeroMemory(@Bt, SizeOf(mBt));
if BOOL(SendMessage(hTrayToolBar, TB_GETBUTTON, WParam(i), LParam(mBt)))
then
begin
ReadProcessMemory(hTrayProcess, mBt, @bt, sizeof(TTBBUTTON), RBytes);
SendMessage(hTrayToolBar, TB_GETRECT, bt.idCommand, LPARAM(mRect));
ReadProcessMemory(hTrayProcess, mRect, @rcTrayIcon, sizeof(TRECT), RBytes);
ClientToScreen(rcTrayIcon.TopLeft);
//New(TInfo);
if hTrayToolTip > 0 then
begin
TInfo^.hwnd := hTrayToolBar;
TInfo^.uId := 0;//bt.idCommand;
// TInfo^.lpszText := p;
TInfo^.cbSize := SizeOf(TINFO);
if Bool(SendMessage(hTrayToolBar, TTM_GETTOOLINFO, 0, LParam(TInfo)))
then
p := '1';
end;
Dispose(TInfo);
//end;
end;
..............
end;
Проблемы начинаются в выделенном блоке. Я несовсем ясно понимаю, чем
заполняется TOOLINFO при посылке сообщения TTM_GETTOOLINFO.
