Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: WinAPI и системное программирование > Форма - hint


Автор: neweraser 15.6.2018, 17:33
Я наверное зачастил на форуме  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;

Выглядит она вот так:
https://imgbb.com/

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

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, 22:39
В общем, пришел к выводу, что нужно найти хэндл или координаты иконки в трее, а потом уже от них отталкиваться. 
Код

  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
Потом набрел на http://rouse.drkb.ru/winapi.php#fwsystrayinfo, который вроде как может помочь, но как именно я пока не догоняю, наверное, пора спать.

Автор: Romikgy 16.6.2018, 23:26
Цитата

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

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

Автор: neweraser 18.6.2018, 10:21
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

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

 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 

Автор: neweraser 18.6.2018, 14:09
Немного косякнул, для трея надо так:
Код

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

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

Автор: neweraser 18.6.2018, 17:16
Нашлось решение, может кому пригодится. В сети действительно очень много вопросов по этому поводу, но работающего кода я так и не нашел. Жаль, что не получилось без сторонних компонентов, хотя можно покопаться в исходниках 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 

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)