| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

иконка в трее без форм [D7, WinXP]

Страницы:   < 1 2 3 >

AHTOLLlKA ©   (2008-11-10 12:55:00) 

подскажите люди добрые...
как засунуть иконку в трей, не используя в uses forms
??????

---

AHTOLLlKA   (2008-11-19 15:11:00) [1]

спасибо и вам Юрий!

---

Юрий Зотов   (2008-11-15 13:01:00) [2]

До кучи. Писал когда-то этот пример, лет 100 назад. Может, снова кому-то пригодится.

program TrayWithoutVCL;

{$M 1024, 1024}

uses
 Windows,
 Messages,
 ShellAPI;

const
 AppName = 'WinApiTrayApp';
 WM_TRAYMSG = WM_USER + 100;

var
 WndClass: TWndClassEx;
 WndHandle: HWND = 0;
 Msg: TMsg;
 IconData: TNotifyIconData;
 IconMenu: HMENU = 0;
 SecondIcon: HICON;

function WndFunc(Wnd, Msg: DWORD; wParam, lParam: integer): integer; stdcall;
var
 P: TPoint;
begin
 case Msg of
   WM_DESTROY, WM_QUERYENDSESSION:
     begin
       Result := Integer(Msg = WM_QUERYENDSESSION);
       PostQuitMessage(0)
     end;
   WM_TRAYMSG:
     begin
       Result := 0;
       if (lParam = WM_RBUTTONDOWN) and GetCursorPos(P) then
       begin
         SetForegroundWindow(Wnd);
         TrackPopupMenuEx(IconMenu, 0, P.X, P.Y, Wnd, nil);
         PostMessage(Wnd, WM_NULL, 0, 0)
       end
     end;
   WM_COMMAND:
     begin
       Result := 0;
       case wParam and $FFFF of
         0: begin
              if IconData.hIcon = SecondIcon then
                IconData.hIcon := WndClass.hIcon
              else
                IconData.hIcon := SecondIcon;
              Shell_NotifyIcon(NIM_MODIFY, @IconData)
            end;
         1: PostMessage(Wnd, WM_CLOSE, 0, 0)
       end
     end;
   else
     Result := DefWindowProc(Wnd, Msg, wParam, lParam)
 end
end;

{ -------------------------------------------------------------------------------------------- }

begin { main }
 with WndClass do
 begin
   cbSize := SizeOf(WndClass);
   Style := CS_HREDRAW or CS_VREDRAW ;
   lpfnWndProc := @WndFunc;
   hIcon := LoadIcon(0, IDI_EXCLAMATION);
   hCursor := LoadCursor(0, IDC_ARROW);
   hbrBackground := hBrush(COLOR_WINDOW);
   lpszMenuName := nil;
   lpszClassName := AppName;
   hIconSm := hIcon
 end;
 WndClass.hInstance := hInstance;
 if RegisterClassEx(WndClass) = 0 then
   Exit;
 WndHandle := CreateWindowEx(WS_EX_TOOLWINDOW, AppName, AppName, WS_OVERLAPPEDWINDOW, 0, 0, 0, 0, 0, 0, hInstance, nil);
 if WndHandle = 0 then
   Exit;
 with IconData do
 begin
   cbSize := SizeOf(IconData);
   Wnd:= WndHandle;
   uID := 100;
   uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
   uCallbackMessage := WM_TRAYMSG;
   hIcon:= WndClass.hIcon;
   szTip := AppName
 end;
 if Shell_NotifyIcon(NIM_ADD, @IconData) then
 try
   IconMenu := CreatePopupMenu;
   if IconMenu <> 0 then
   try
     if AppendMenu(IconMenu, MF_STRING, 0, 'Сменить иконку') and
        AppendMenu(IconMenu, MF_STRING, 1, 'Выход') then
     begin
       SecondIcon := LoadIcon(0, IDI_QUESTION);
       while GetMessage(Msg, 0, 0, 0) do
       begin
         TranslateMessage(Msg);
         DispatchMessage(Msg)
       end
     end
   finally
     DestroyMenu(IconMenu)
   end;
 finally
   Shell_NotifyIcon(NIM_DELETE, @IconData)
 end
end.


---

AHTOLLlKA   (2008-11-11 07:50:00) [3]

Спасибо тебе большое Sapersky!!!
это то что нужно... сейчас буду сидеть разбираться!
всем кто помогал спасибо что уделили время

---

Sapersky   (2008-11-10 16:33:00) [4]

http://sapersky.narod.ru/files/TrayIcon.rar

Не знаю, поможет или наоборот усугубит... :)

---

Сергей М.   (2008-11-10 15:30:00) [5]

потому что у тебя h_Wnd = 0

---

AHTOLLlKA   (2008-11-10 15:21:00) [6]

в том то и дело что нет (((

и так же изчезает ((

---

Сергей М.   (2008-11-10 15:18:00) [7]

> AHTOLLlKA   (10.11.08 15:10) [40]


Вот как ты отформатировал, так и видно что "добавил".

Рууи бы поотрывать за такое форматирование текста программы !

Ну так что, диал.окно 'test' открывается при елозаньи мышью в области иконки ?

---

AHTOLLlKA   (2008-11-10 15:10:00) [8]

> А вот в [35] есть.Дело за малым - самомтоятельно дотумкать,
>  куда этот фрагмент приспособить.Задачка для школьника)

дак я же добавил это в
function WndProc(hWnd: HWND; Msg: UINT;  wParam: WPARAM;  lParam:
LPARAM): LRESULT; stdcall

---

Сергей М.   (2008-11-10 15:08:00) [9]

> ткните в коде где ОНО


Его нет, понимаешь ? Совсем нет. То есть напрочь отсутствует.
Так что тыкать некуда.

А вот в [35] есть.
Дело за малым - самомтоятельно дотумкать, куда этот фрагмент приспособить.
Задачка для школьника)


> почему изчезает


Вот потому и исчезает.

---

AHTOLLlKA   (2008-11-10 15:01:00) [10]

program APIForm;
uses
 Windows, Messages,ShellApi,Graphics;

const
 TITLE = '11111111';
WM_NOTIFYTRAYICON = WM_USER + 1;

var
 h_Wnd  : HWND;
 tray: TNotifyIconData;
 TrayIcon: TIcon;

function WndProc(hWnd: HWND; Msg: UINT;  wParam: WPARAM;  lParam:
LPARAM): LRESULT; stdcall;
begin
 case (Msg) of
   WM_CREATE:
     begin { а здесь могло бы быть то что выполняется при старте проги }
     end;
   WM_CLOSE:
     begin
       PostQuitMessage(0);
       Result := 0
     end;

WM_NOTIFYTRAYICON:
begin
 case lparam of

WM_RBUTTONUP:
begin
//
end;

WM_LBUTTONUP:
begin
//
end;

WM_MOUSEMOVE:
begin
messagebox(0,'test','test',0);
end;

 end;
 Result := 0;
end;

{WM_LBUTTONDOWN:
begin
// а здесь могло бы быть то что выполняется при старте проги
end;

WM_LBUTTONDBLCLK:
begin
// а здесь могло бы быть то что выполняется при старте проги
end;

WM_LBUTTONUP:
begin
// а здесь могло бы быть то что выполняется при старте проги
end;

WM_RBUTTONDOWN:
begin
// а здесь могло бы быть то что выполняется при старте проги
end;

WM_RBUTTONDBLCLK:
begin
// а здесь могло бы быть то что выполняется при старте проги
end;

WM_RBUTTONUP:
begin
// а здесь могло бы быть то что выполняется при старте проги
end;

WM_MOUSEMOVE:
begin
messagebox(0,'test','test',0);
end;  }

   else
     Result := DefWindowProc(hWnd, Msg, wParam, lParam);
 end;
end;

function APIFormC(Width, Height : Integer ) : Boolean;
var
 wndClass : TWndClass;         { Window class }
 dwStyle ,                     { Window styles }
 dwExStyle : DWORD;            { Extended window styles }
 h_Instance : HINST;           { Current instance }
begin
 h_Instance := GetModuleHandle(nil);     { Grab An Instance For Our
Window }
 with wndClass do                    { Set up the window class }
 begin
   style         := CS_HREDRAW or    { Redraws entire window if length
changes }
                    CS_VREDRAW or    { Redraws entire window if height
changes }
                    CS_OWNDC;        { Unique device context for the
window }
   lpfnWndProc   := @WndProc;        { Set the window procedure to our
func WndProc }
   hInstance     := h_Instance;
   hCursor       := LoadCursor(0, IDC_ARROW);
   hbrBackground := COLOR_WINDOW; { стандартный цвет окна(можно так
445566 (RGB), или просто clred (красный) ) }
   lpszClassName := 'APIForm';
 end;
 RegisterClass(wndClass);
 dwStyle := WS_OVERLAPPEDWINDOW; { форма с кнопками  вверху }
 dwExStyle := WS_EX_APPWINDOW;   { форма со значком приложения в углу }
 h_Wnd := CreateWindowEx(dwExStyle,     { Extended window styles }

                         'APIForm',     { Class name }
                         TITLE,         { Window title (caption) }
                         dwStyle,      { Window styles }
                         0, 0,          { позиция окна(левый верхний
угол) }
                         Width, Height, { Размеры Width и Heught
соответственно }
                         0,             { No parent window }
                         0,             { No menu }
                         h_Instance,    { Instance }
                         nil);          { Pass nothing to WM_CREATE }
 if h_Wnd = 0 then
 begin
   MessageBox(0, 'Не могу создать окно!', 'Ошибка', MB_OK or
MB_ICONERROR);
   Result := False;
   Exit;
 end;
 ShowWindow(h_Wnd, SW_SHOW);
 SetForegroundWindow(h_Wnd);
 SetFocus(h_Wnd);
 Result := True;
end;

function WinMain(hInstance : HINST; hPrevInstance : HINST;
                lpCmdLine : PChar; nCmdShow : Integer) : Integer; stdcall;
var
 msg : TMsg;
 finished : Boolean;
begin

 Finished := False;
 APIFormC( 400, 200 );  { ширина и высота }

 while not finished do
 begin
   if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then { Check if there is a
message for this window }
   begin

     if (msg.message = WM_QUIT) then     { If WM_QUIT message received
then we are done }
       finished := True
     else begin                              { Else translate and
dispatch the message to this window }
      TranslateMessage(msg);
       DispatchMessage(msg);
     end;
   end;
 end;
 Result := msg.wParam;

end;

begin

with tray do
begin
cbSize := sizeof(TNotifyIconData);
wnd := h_Wnd;
uID := 0;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
uCallBackMessage := WM_NOTIFYTRAYICON;
hIcon := LoadIcon(0, IDI_ASTERISK);
szTip := ('My Resident');
end;
Shell_NotifyIcon(NIM_ADD, @tray);

WinMain( hInstance, hPrevInst, CmdLine, CmdShow );

end.


пока с протянутой... ога...
ну ткните в коде где ОНО почему изчезает все равно иконка в треее то...=(((

---

Сергей М.   (2008-11-10 14:55:00) [11]

> AHTOLLlKA   (10.11.08 14:44) [31]


Бросай эту гнилую затею - так и будешь с протянутой рукой сюда ходить по каждому чиху)

---

Anatoly Podgoretsky   (2008-11-10 14:53:00) [12]

> Leonid Troyanovsky  (10.11.2008 14:48:34)  [34]

Это не мзда, это расплата за отказ.

---

Сергей М.   (2008-11-10 14:52:00) [13]

> что делать при срабатывании сообщения


WM_NOTIFYTRAYICON:
begin
  case lparam of
    WM_RBUTTONUP: ..
    WM_LBUTTONUP: ..
    WM_MOUSEMOVE:..
...
  end;
  Result := 0;
end;

---

Leonid Troyanovsky   (2008-11-10 14:48:00) [14]

> AHTOLLlKA   (10.11.08 14:44) [31]

> многое.. понятно... а хоть что-нибудь подскажите что там
> обрабатывать...

Читать msdn.
Это небольшая мзда за отказ от forms.

--
Regards, LVT.

---

AHTOLLlKA   (2008-11-10 14:48:00) [15]

дак я понять не могу как оставить ее на месте при наведении мышкой на неее (((((

---

Поросенок Винни-Пух   (2008-11-10 14:46:00) [16]

и что делать при срабатывании сообщения

можно хрюкать при левом клике на иконке. а при правом клике на иконке можно собачий вальс проиграть.

---

AHTOLLlKA   (2008-11-10 14:44:00) [17]

многое.. понятно... а хоть что-нибудь подскажите что там обрабатывать...

и что делать при срабатывании сообщения

---

Сергей М.   (2008-11-10 14:33:00) [18]

> я ее если там добавлю.. что делать при ее обработке тогда


Как минимум сформировать результат обработки.

Всё это (и многое-многое другое) следует делать ручками, раз ты отказался от forms.

---

@!!ex   (2008-11-10 14:16:00) [19]

> из-за этого пропадает иконка ??

Да. Винда не получает результата обработки и считает, что иконка сдохла.

---

AHTOLLlKA   (2008-11-10 14:13:00) [20]

не понимаю...
тоесть окей, я ее если там добавлю.. что делать при ее обработке тогда ??

из-за этого пропадает иконка ??

---

Страницы:   < 1 2 3 >

Наверх