Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Форма - hint, по координатам приложения в трее 
V
    Опции темы
neweraser
Дата 15.6.2018, 17:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6



Я наверное зачастил на форуме  smile Ну хоть не скучно будет  smile 
Проблема вот в чем:
Есть форма, которую собираюсь использовать как хинт из приложения, которое свернуто в трей.
Вот код, если кому инетресно (в дальнейшем планирую размещать на ней свои компоненты:
Код

procedure TForm1.CreateWindowsRegions(const X, Y: Integer;
  const RegionHandle: THandle);
var
  PointsArray : Array[0..3] of TPoint;
  R1, R2 : THandle;
begin
  R1:= CreateRoundRectRgn(0, 0, Round(X*0.917), Round(Y*0.952), 40, 40);
  PointsArray[0]:= Point(Round(X*0.917), Round(Y*0.857));
  PointsArray[1]:= Point(X, Y);
  PointsArray[2]:= Point(Round(X*0.917), Round(Y*0.952));
  PointsArray[3]:= Point(0, Round(Y*0.952));
  R2:= CreatePolygonRGN(PointsArray, 4, Winding);
  CombineRgn(R1,R1,R2,RGN_OR);
  SetWindowRGN(RegionHandle, R1, true);
end;

Выглядит она вот так:
user posted image

Рисую и в правый нижний угол ставлю так:
Код

procedure TForm1.FormCreate(Sender: TObject);
var
  r: TRect;
  i, index: integer;
  x, y: integer;
begin
  CreateWindowsRegions(Width, Height, Handle);
  x:= screen.WorkAreaWidth;
  y:= screen.WorkAreaHeight;
  getWindowRect(Handle ,r);
  dec(y, r.Bottom  - r.Top + 2);
  setWindowPos(Handle, HWND_TOPMOST, x - (r.Right - r.left), y, r.Right - r.Left, r.Bottom - r.Top , SWP_SHOWWINDOW + SWP_NOACTIVATE);
end;


Как сделать, чтобы эта подсказка "хвостиком" указывала на иконку приложения в трее, а не на правый нижний угол?

ps. Я разделом не ошибся? А то во все по очереди пишу  smile 

Это сообщение отредактировал(а) neweraser - 15.6.2018, 17:36


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
neweraser
Дата 15.6.2018, 22:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6



В общем, пришел к выводу, что нужно найти хэндл или координаты иконки в трее, а потом уже от них отталкиваться. 
Код

  Form1.Left:= X - Form1.Width;
  Form1.Top:= Y - Form1.Height;

Штатными средствами, как я понял, это сложно сделать, наткнулся на Cool Tray Icon, в котором есть функция 
Код

CoolTrayIcon1.GetClientIconPos(X, Y);

Но она возвращает только позицию курсора внутри иконки, и то если мышка наведена, правильно?
Вот, кстати, тут обсуждалось http://forum.vingrad.ru/forum/topic-263233.html
Потом набрел на класс, который вроде как может помочь, но как именно я пока не догоняю, наверное, пора спать.


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
Romikgy
Дата 16.6.2018, 23:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7325
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 13
Всего: 146



Цитата

// Shell_TrayWnd
//    |- Button                     - кнопка старт
//    |- ReBarWindow32
//    |    |- MSTaskSwWClass
//    |    |    +- ToolbarWindow32  - кнопки приложений
//    |    +- ToolbarWindow32       - всякие панели
//    +- TrayNotifyWnd
//         |- TrayClockWClass       - это там где часики ;)
//         |- SysPager
//         |    +- ToolbarWindow32  - это наши иконки

находите ToolbarWindow32  , перебираете все окна 
GetWindowThreadProcessId(Wnd, @CurrentPID);
находите пид процесса и сравниваете со своим ... совпадает, у окна берете координаты и отрисовываете свое окно по координатам

Это сообщение отредактировал(а) Romikgy - 16.6.2018, 23:27


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile

PM   Вверх
neweraser
Дата 18.6.2018, 10:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6



Romikgy, не выходит так.. сейчас приведу код с комментариями:
Код

procedure TForm1.Button2Click(Sender: TObject);
begin
    ListTray64(Memo1.Lines)
end;


Код

procedure TForm1.ListTray64(List: TStrings);
var
  tb64: TBBUTTON64;
  hWindow: THandle;
  hProcess: THandle;
  ThreadId : Cardinal;
  dwCount: Integer;
  lpPid      : Cardinal;
  tbTray : TRAYDATA;
  lpPointer: Pointer; // ^TBBUTTON64;
  dwIndex: Integer;
  cbRead : Cardinal;
  ph: Pointer;
  ps: string;
begin
  List.Clear;
  // Ищем окно системного трея
  hWindow := FindWindowW('Shell_TrayWnd', 0);
  hWindow := FindWindowExW(hWindow, 0, 'TrayNotifyWnd', 0);
  hWindow := FindWindowExW(hWindow, 0, 'SysPager', 0);
  hWindow := FindWindowExW(hWindow, 0, 'ToolbarWindow32', 0);
  // получаем количество иконок в окне системного трея.
  dwCount := SendMessageA(hWindow, TB_BUTTONCOUNT, 0, 0);
  // получаем ID процесса через handle окна
  ThreadId := GetWindowThreadProcessId(hWindow, @lpPid);
  // получаем handle процесса через ID процесса
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, FALSE, lpPid);
  // выдяем кусок памяти в процессе
  lpPointer := VirtualAllocEx(hProcess, nil, SizeOf(tb64), MEM_COMMIT, PAGE_READWRITE);
  // перебираем иконки
  for dwIndex := 0 to dwCount - 1 do
  begin
    if (SendMessageA(hWindow, TB_GETBUTTON, dwIndex, Integer(lpPointer)) = 0) then
    Continue;
    if ReadProcessMemory(hProcess, lpPointer, @tb64, SizeOf(tb64), SIZE_T(cbRead)) Then
    //if ReadProcessMemory(hProcess, lpPointer, @tb64, SizeOf(tb64), cbRead) Then
    begin
      if (tb64.dwData <> nil) Then
      begin
        // заполняем структуру tb64
        ReadProcessMemory(hProcess, tb64.dwData, @tbTray, SizeOf(tbTray), SIZE_T(cbRead));
        // получаем имя процесса (владельца иконки) через handle процесса
        // взятого из структуры tb64
        ps := GetProcessNameByhWnd(tbTray.wnd);
        // Запоминаем handle процесса
        Integer(ph) :=  tbTray.wnd;
        // кладем имя и handle процесса в StringList
        List.AddObject(ps,ph);
      end;
    end;
  end;
  // Освобождаем память
  VirtualFreeEx(hProcess, lpPointer, 0, MEM_RELEASE);
  CloseHandle(hProcess);
end;


Код

function TForm1.GetProcessNameByhWnd(dwhWnd: THandle): WideString;
var
  hDll : THandle;
  fGetProcessImageFileNameW: function (hProcess: THandle; lpImageFileName: PWideChar; nSize: Cardinal): Cardinal; stdcall;
  pBuffer  : PWideChar;
  dwProcess : Cardinal;
  dwPid    : Cardinal;
  dwThread  : Cardinal;
  cb        : Cardinal;
  isPsapiLoaded : Boolean;
begin
  Result := '';
  isPsapiLoaded := False;
  // подгружаем функцию GetProcessImageFileNameW
  hDll := GetModuleHandle('kernel32.dll');
  if (hDll = 0) then  Exit;
  // Для Windows 7 и Windows Server 2008 R2 она доступна в kernel32.dll
  @fGetProcessImageFileNameW := GetProcAddress(hDll, 'GetProcessImageFileNameW');
  if (@fGetProcessImageFileNameW = nil) then
  begin
    hDll := GetModuleHandle('psapi.dll');
    // psapi.dll может оказаться не агруженной
    if (hDll = 0) then
    begin
      hDll := LoadLibrary('psapi.dll');
      isPsapiLoaded := (hDll <> 0);
    end;
  end;
  if (hDll = 0) then  Exit;
  // Windows Server 2008, Windows Vista, Windows Server 2003, и Windows XP/2000
  // она доступна в Psapi.dll
  @fGetProcessImageFileNameW := GetProcAddress(hDll, 'GetProcessImageFileNameW');
  if (@fGetProcessImageFileNameW = nil) then
  Exit;
  // подключаемся к процессу
  dwThread := GetWindowThreadProcessId(dwhWnd, @dwPid);
  dwProcess := OpenProcess(PROCESS_ALL_ACCESS, FALSE, dwPid);
  // получаем имя
  GetMem(pBuffer,4096);
  cb := fGetProcessImageFileNameW(dwProcess, pBuffer, 4096);
  if (cb <> 0) then
    Result :=  WideString(pBuffer);
  // освобождаем память
  CloseHandle(dwProcess);
  FreeMem(pBuffer);
  @fGetProcessImageFileNameW := nil;
  if isPsapiLoaded then
    FreeLibrary(hDll);
end;


Код

type
  TBBUTTON64 = packed record
    iBitmap: Integer;
    idCommand: Integer;
    fsState: BYTE;
    fsStyle: BYTE;
    bReserved: array [0..5] of BYTE;    // padding for alignment  64bit
    dwData: Pointer;                    //DWORD_PTR;
    iString: Pointer;                  //INT_PTR;
  end;

const
  TB_BUTTONCOUNT  = WM_USER + 24;
  TB_GETBUTTON    = WM_USER + 23;


В мемо загружается вот это:
Код

\Device\HarddiskVolume2\Windows\explorer.exe
\Device\HarddiskVolume2\Windows\explorer.exe
\Device\HarddiskVolume2\Windows\explorer.exe



--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
neweraser
Дата 18.6.2018, 11:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6



Блин. Я уже согласен использовать любой компонент, что угодно. Столько времени потерять. Ну или хотя бы найти координаты трея?
Если рисую форму по этим 
Код

 GetWindowRect(FindTrayToolbar, r);
 hX:= r.Width;
 hY:= r.Height;

Код

function TForm1.FindTrayToolbar: HWND; // el
begin
  Result := FindWindow('Shell_TrayWND', nil);
  Result := FindWindowEx(Result, 0, 'TrayNotifyWnd', nil);
  Result := FindWindowEx(Result, 0, 'SysPager', nil);
  Result := FindWindowEx(Result, 0, 'ToolbarWindow32', nil);
end;

то она оказывается вообще в верхнем левом углу  smile 


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
neweraser
Дата 18.6.2018, 14:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6



Немного косякнул, для трея надо так:
Код

 hX:= r.Left;
 hY:= r.Top;

А вообще сейчас пробую через Cool Tray Icon по функции TrayIcon.SetFocus отловить хэндл сфокусированной иконки

Это сообщение отредактировал(а) neweraser - 18.6.2018, 14:10


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
neweraser
Дата 18.6.2018, 17:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6



Нашлось решение, может кому пригодится. В сети действительно очень много вопросов по этому поводу, но работающего кода я так и не нашел. Жаль, что не получилось без сторонних компонентов, хотя можно покопаться в исходниках Cool Tray Icon и отталкиваться оттуда. Но, так как я и так использую у себя в проекте этот компонент - мне не за чем smile
Привожу код:
Код

procedure TForm1.Button1Click(Sender: TObject);
var
  r: TRect;
  Currentid, id:DWORD;
  i: Integer;
begin
  CoolTrayIcon1.SetFocus; // Устанавливаем фокус на иконке
  id:= GetWindowThreadProcessId(GetForegroundWindow, nil); // ID процеса с фокусом
  Currentid := GetCurrentThreadId; // ID нашего процесса
  AttachThreadInput(Currentid, id, true); // Объединяем процессы
  i:= 0;
  while True do // Ждем 100 мс чтоб фокус наверняка стал на иконке
  begin
    Application.ProcessMessages;
    Sleep(1);
    if i = 100 then
      break;
    inc(i);
  end;
  hHWND:= GetFocus; // Забираем хэндл фокуса
  AttachThreadInput(Currentid, id, false); // Разделяем процессы
  GetWindowRect(hHWND, r); // Берем координаты нашей иконки
   hX:= r.Left;
   hY:= r.Top;
   if Form2 <> nil then // Показываем форму-хинт
     Form2.Free;
   Form2:= TForm2.Create(Self);
   Form2.Show;
end;


Со стандартной темой windows (NT) не работает  smile 

Это сообщение отредактировал(а) neweraser - 19.6.2018, 18:01


--------------------
Кто ищет, тот всегда найдет.
PM MAIL ICQ Skype   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.1453 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.