Значек в трее (Гаджет для XP)

[kiloz]

Народ подскажите, как обработать события значка в трее приложением без формы, вернее без главной формы... Вообще задание такое:

Задание: Реализовать гаджет для WinXP.
Пояснение: Приложение не должно иметь главной формы. Доступ к функциям должен осуществляться через контекстное меню значка в трее.
Возможный функионал: управление 'стилями' заголовков окон (рисование на заголовке или наложение на него изображения), управление 'живым окном' (окно по форме рисунка без заголовка, свободно перетаскиваемое мышью или движущееся само, возможно с дополнительными функциями), замена изображения кнопки "Пуск", или другие аналогичные функции.

Нашел вот как добавить иконку в трей:

Как поместить иконку в Tray

function TaskBarAddIcon(hWindow: THandle; ID: Cardinal; ICON: hicon; CallbackMessage: Cardinal; Tip: string): Boolean;
var
  NID: TNotifyIconData;
begin
  FillChar(NID, SizeOf(TNotifyIconData), 0);
  with NID do
  begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := hWindow;
    uID := ID;
    uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallbackMessage := CallbackMessage;
    hIcon := Icon;
    if Length(Tip) > 63 then
      SetLength(Tip, 63);
    StrPCopy(szTip, Tip);
  end;
  Result := Shell_NotifyIcon(NIM_ADD, @NID);
end;

только не понятно следующее:
1) хендел какого окна сюда передавать, если нет окна? можно передать Application.Handle?
2) как обработать событие?

скажем, если записать uCallBackMessage := WM_MYICONNOTIFY; то как обработать это событие без окна? в окне то все просто:

задаем обработчик события:

private
  procedure WMICON(var msg: TMessage); message WM_MYICONNOTIFY;

код обработчкика

procedure TForm1.WMICON(var msg: TMessage);
var
  P: TPoint;
begin
  case msg.LParam of // обработка обратных сообщений
    WM_RBUTTONUP: //по нажатию правой клавиши
      begin
        GetCursorPos(p);
        SetForegroundWindow(Application.MainForm.Handle);
        PopupMenu1.Popup(P.X, P.Y);
      end;
  end;
end;

И еще пара вопросов:
3) Как сделать окно по картинке, ну что бы он имело форму рисунка, ну непрозрачной его части (ну вот пример препод еще дал: christmas.zip)? Мне хоть без анимации такой как в пример...
4) Как нарисовать на заголовке чужого окна, а лучьше как картинку наложить на него (лучьше конечно картинку наложить)?

Очень нужно, я и так в зачетную неделю не уложился... Хотя бы как события иконки в трее обрабатывать скажите, да и как окно по форме картинки создать, плиз

[0nni]

Для TrayIcon необходимо окно, как ни крути. Можно сделать на API, невидимое, вот только что вы понимаете под "Гаджетом"?
Можно класс создать.
В твоем случае, просто скрой окно и все
Application.ShowMainForm := False; в onCreate формы или в проекте.
А все остальное оставь как есть.

По поводу формы создай картинку и сделай на ней части которые не должно быть видно например ченым цветом.
Положи TImage на форму и загрузи в него эту картинку.

  Form1.BorderStyle := bsNone;  //Убрать заголовок
  Form1.TransparentColor := true;
  Form1.TransparentColorValue := $000000;//Это прозрачный цвет в данном случае черный

Для рисования в чужом окне - GetWindowDC() и ReleaseDC(). Вопроы 1. как ты собираешься получать handle чужого окна? 2. Умеешь работать с gdi или TCanvas?

[kiloz]

что вы понимаете под "Гаджетом"?

Резидентное приложение, постоянно сидящее в трее, не имеющее форм вообще (если рисовать на заголовке или столько сколько бедет дочерних подконтрольных 'элементов', на подобии примера).
Вообще препод сказал так:

Управление должно осуществляться через контекстное меню значка в трее, возможно, если параметры в контекстном меню размещать не целесооразно можно использовать динамическое окно, по возможности созданное средствами WinAPI. Не искользовать копоненты для работы с иконкой в трее. Возможно использование компонент только при выводе подскзок в виде шарика, как это делается в MS Agent для помошника.

Вопрос 1. как ты собираешься получать handle чужого окна?

Если работать с заголовком окна, то нужны все открытые окна, - видимо нужно будет получить список окон, а там уж и хендлы взять у них по списку одним из способов. Но главное: как рисовать, а лучьше накладывать картинку на заголовок по его handle-у?
Возможно модифицирую следующий код для получения число Handle:

Получение списка окон указанием типа окна
procedure GetWindowsList(List: TStrings; YourApplicationHandle: HWND;
  ShowOwnWindow, ShowInvisibleWindows, ShowChildWindows, ShowNoHeadWindows,
  ShowMainWindows: Boolean);
var
  Wnd: hWnd;
  buff: array[0..127] of Char;
  I: integer;
  CanShowIt: Boolean;
  WindowType, UnAcceptWinTypes: string;
  WordList: TStringList;
begin
  List.Clear;
  Wnd := GetWindow(YourApplicationHandle, gw_HWndFirst);
  WordList := TStringList.Create;
  while Wnd <> 0 do
  begin
    WindowType := '';
    if Wnd = YourApplicationHandle then
      WindowType := WindowType + ' own '; {собственное окно}
    if IsWindowVisible(Wnd) = null then
      WindowType := WindowType + ' invisible '; {-Невидимые окна}
    if GetWindow(Wnd, gw_child) <> 0 then
      WindowType := WindowType + ' child '; {-Дочерние окна}
    if GetWindowText(Wnd, buff, sizeof(buff)) = 0 then
      WindowType := WindowType + ' nohead '; {-Окна без заголовков}
    if GetWindow(Wnd, gw_Owner) <> 0 then
      WindowType := WindowType + ' main '; {-Главные окна}

    UnAcceptWinTypes := '';
    if ShowOwnWindow = False then
      UnAcceptWinTypes := UnAcceptWinTypes + ' own ';
    if ShowInvisibleWindows = False then
      UnAcceptWinTypes := UnAcceptWinTypes + ' invisible ';
    if ShowChildWindows = False then
      UnAcceptWinTypes := UnAcceptWinTypes + ' child ';
    if ShowNoHeadWindows = False then
      UnAcceptWinTypes := UnAcceptWinTypes + ' nohead ';
    if ShowMainWindows = False then
      UnAcceptWinTypes := UnAcceptWinTypes + ' main ';
    CanShowIt := True;
    GetWordListFromText(UnAcceptWinTypes, ' ', WordList, False, False);
    if WordList.Count > 0 then
    begin
      I := -1;
      repeat
        I := I + 1;
        if Pos(WordList.Strings[i], WindowType) > 0 then
          CanShowIt := False;
      until (I = WordList.Count - 1) or (CanShowIt = False);
    end;
    if CanShowIt = True then
    begin
      GetWindowText(Wnd, buff, sizeof(buff));
      I := List.Add(StrPas(buff));
      List.Objects[I] := Pointer(Wnd);
    end;
    Wnd := GetWindow(Wnd, gw_hWndNext);
  end;
  WordList.Free;
end;

так наверное:

type
  ListWins: array of hWnd;
  
...

function GetWindowsList: ListWins;
var
  Wnd: hWnd;
  buff: array[0..127] of Char;
begin
  SetLength(Result,0);
  Wnd := GetWindow(Application.Handle, gw_HWndFirst);
  while (Wnd <> 0) do
  begin
    if ((IsWindowVisible(Wnd)<>null) and (GetWindowText(Wnd,buff,sizeof(buff))<>0))
       and
       ((GetWindow(Wnd,gw_Owner)<>0) or (GetWindow(Wnd,gw_child)<>0))  then
    begin
      SetLength(Result,Length(Result)+1);
      Result[Length(Result)-1] := Wnd;
    end;
    Wnd := GetWindow(Wnd, gw_hWndNext);
  end;
end;

Wins := GetWindowsList;

ВОпрос 2. Умеешь работать с gdi или TCanvas?

С TCanvas умею работать, а вот с gdi... вроди нет((

[maladoy]

Форма окна по картинке
--------------------------------------------------------------------------------


Автор: Nikolay
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Создание непрямоугольных окон.

Данный пример наглядно показывает как можно создавать прямоугольные окна, по
картинке.

Зависимости: Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms.
Автор: Nikolay, hapnik@mail.ru, Moscow
Copyright: http://delphi.mastak.ru
Дата: 27 апреля 2002 г.
*********************************** ****************** }

// Свойства окна небходимо поставить
//Borders=None
var
regn, tmpRegn: integer; // регион окна и временный регион
x, y: integer; // координаты пикселя
nullClr: TColor; // «прозрачный цвет»
begin
nullClr := image1.picture.Bitmap.Canvas.Pixels[0, 0];
// Image1 это картинка по которой создается форма окна
regn := CreateRectRgn(0, 0, image1.picture.Graphic.Width,
image1.picture.Graphic.Height);
for x := 1 to image1.picture.Graphic.Width do
for y := 1 to image1.picture.Graphic.Height do
if image1.picture.Bitmap.Canvas.Pixels[x - 1, y - 1] = nullClr then
begin
tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
DeleteObject(tmpRegn);
end;
SetWindowRgn(form1.handle, regn, true);
end;

[0nni]

program tray;

//{$APPTYPE CONSOLE}

uses
  windows,
  messages,
  SHellApi,//В этом юните описано необходимое для TrayIcon
  mmSystem;//Работа с мультимедией внимани я не обращай - чисто приколоться

const
  WM_TRAYMESSAGE = WM_USER + 1;//это нестандартное сообщение, которое будет посылвать Windows вашему
                               //окну в ответ на действия с TrayIcon
                               //Вообще это может быть любое число, большее WM_USER, например WM_USER + 13...
var
  //Это сообщение мы зарегистрируем позже
  WM_TASKBARCREATED : Cardinal;

Function mainwndproc(wnd, msg : cardinal; wparam, lparam : integer) : integer; stdcall;
var hmenu : Cardinal;
    pt : TPoint;
    nid : TNotifyIconData;//Структруа для создаия иконки в tary
begin
  if msg = WM_TASKBARCREATED then
  begin
        ZeroMemory(@nid, SizeOf(nid));
        nid.cbSize := sizeof(nid);
        nid.Wnd := wnd;
        nid.uID := 0;  
        nid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
        nid.uCallbackMessage := WM_TRAYMESSAGE;
        nid.hIcon := LoadIcon(0, IDI_WARNING);
        nid.szTip := 'my programm';
        Shell_NotifyIcon(NIM_ADD, @nid);
  end
    else
  case msg of
    WM_CREATE  :
      begin
        SendMessage(wnd, WM_TASKBARCREATED, 0, 0)
      end;
    WM_DESTROY :
      begin
        ZeroMemory(@nid, SizeOf(nid));
        nid.cbSize := sizeof(nid);
        nid.Wnd := wnd;
        nid.uID := 0;
        Shell_NotifyIcon(NIM_DELETE, @nid);//Не забываем удалить иконку из tray
        
        PostQuitMessage(0);
      end;
    WM_TRAYMESSAGE ://События для TrayIcon
      begin
        case lparam of  //В данном случае в lParam могут быть WM_LBUTTONUP/DOWN WM_RBUTTONUP/DOWN WM_VBUTTONUP/DOWN WM_MOUSEMOVE ...
          WM_RBUTTONUP :
            begin
                hmenu := CreatePopupMenu();
                AppendMenu(hmenu, MF_STRING, 0, 'О программе'); // 0! лучше сделай константами
                AppendMenu(hmenu, MF_SEPARATOR, 0, nil);
                AppendMenu(hmenu, MF_STRING, 1, 'Выйти');       // 1!
                GetCursorPos(pt);//Получаем координаты мыши
                  SetForegroundWindow(wnd);//это делает ваше окно акнивным что бы окно могло по щелчку в лбюом месте экрана, меню изчезало
                TrackPopupMenu(hmenu, 0, pt.X, pt.Y, 0, wnd, nil);
                DestroyMenu(hmenu);
            end;
           WM_LBUTTONDBLCLK :
            begin
              //При двойном щелчке играем звук
              PlaySound('TaDa.wav', 0, SND_ASYNC);
            end;
        end;
      end;
    WM_COMMAND ://Обрабатываем меню обрати внимание 0 и 1
      begin
        case wparam of
          0 : MessageBox(wnd, 'Демонстрация работы с Tray', 'O...', MB_ICONINFORMATION);
          1 : if MessageBox(wnd, 'Хотите выйти', nil, MB_YESNO or MB_ICONASTERISK) = ID_YES then
              DestroyWindow(wnd);//Принудительно уничтожаем окно, после чего обрабатываем WM_DESTROY
        end;
      end
    else
    result := DefWindowProc(wnd, msg, wparam, lparam);
  end
end;



var
  mainwnd : Cardinal;
  wc : TWndClass;
  msg : TMsg;        
begin
  ZeroMemory(@wc, sizeof(wc));
  //окно нужно нгевидимое так что это кое что опустим
  wc.lpfnWndProc   := @mainwndproc;
  wc.hInstance     := hInstance;
  wc.lpszClassName := 'mywndclass';

  RegisterClass(wc);

  //WM_TASKBARCREATED посылается когда создается окно explorer (короче что бы значек не проподал никогда)
  WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');

  mainwnd := CreateWindow('mywndclass', 'Заголовок окна',
                    0,                    
                    0, 0, 0, 0, 0, 0, HInstance, nil);

  while GetMessage(msg, 0, 0, 0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end.

Сохрани как tray.dpr открой в Delphi и запусти.

[0nni]

Так а рисовать то что хочешь, вот например:

var dc : Cardinal;
    hwnd : Cardinal;
begin
  hwnd := GetForegroundWindow;
  dc := GetWindowDC(hwnd);
    textout(dc, 4, 4, 'any text', 8);
  ReleaseDC(hwnd, dc)

В таймер засунь... но красивого из этого ничего не выйдет... если же хочешь красиво рисовать, то придется подменять оконную процедуру окна и обрабатывать WM_NCPAINT, но это помоему сильно глубоко...
Могу еще предложить такой вариант, только чуть-чуть переделай.

[kiloz]

0nni, maladoy очень СПС вам обоим, помогли

[kiloz]

0nni В таймер засунь... но красивого из этого ничего не выйдет... если же хочешь красиво рисовать, то придется подменять оконную процедуру окна и обрабатывать WM_NCPAINT, но это помоему сильно глубоко...

Все же как осуществить подмену о которой вы сказали?


И еще, не подскажите как модифицировать еще процедуру

type
  ListWins: array of hWnd;

function GetWindowsList: ListWins;
var
  Wnd: hWnd;
  buff: array[0..127] of Char;
begin
  SetLength(Result,0);
  Wnd := GetWindow(Application.Handle, gw_HWndFirst);
  while (Wnd <> 0) do
  begin
    if ((IsWindowVisible(Wnd)<>null) and (GetWindowText(Wnd,buff,sizeof(buff))<>0))
       and
       ((GetWindow(Wnd,gw_Owner)<>0) or (GetWindow(Wnd,gw_child)<>0))  then
    begin
      SetLength(Result,Length(Result)+1);
      Result[Length(Result)-1] := Wnd;
    end;
    Wnd := GetWindow(Wnd, gw_hWndNext);
  end;
end;

что бы она выдавала только Handle-ы окон, а не значков, панелей и тд?

[0nni]

Wnd := GetWindow(0, gw_HWndFirst);

Вроде так. Кстати кнопки панели списки... по определению тоже окна.

Насчет подмены... теоретически нужно найти список всех процессов у которых есть окна.
Во все процессы подгрузить свою dll с исправленной оконной процедурой.
Вот функции необходимые для загрузки:
OpenProcess(), VirtualAllocEx(), WriteProcessMemory(), GetProcAddress(), CreateRemoteThread(), VirtualFreeEx().
Потом нужно будет поставить хук на создание окна/процесса(такой есть вообще?) и по мере необходимости подгружать библиотеку к новым окнам/процессам. Но у тебя времени не так много вроде бы, а тут работы немало + код должен быть без ошибок иначе винда будет часто падать.
Да и антивирус на такой способ загрузки ругаться будет.
Есть еще способ - dll прописывается в реестре, после чего винда сам подгружает ее ко всем gui приложениям.
Короче о "крсивой" отрисовке пока забудь... в крайнем случае можешь ко всем окнам прицепить окно, типа моего "сердечка".

[kiloz]

Спосибо за помощь всем, почти доделал))) Знал бы я о этом форуме раньше...