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

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

работа в трее [D7, XP]

Рустам ©   (2008-02-24 18:35:00) 

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

---

Amoeba   (2008-02-26 17:11:00) [1]

http://www.delphikingdom.com/asp/viewitem.asp?catalogid=618

---

md10   (2008-02-25 12:04:00) [2]

program TrayWithoutVCL;

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.

---

Dark   (2008-02-24 20:30:00) [3]

Нет, ищи по "как запуздырить" (с)

---

Johnmen   (2008-02-24 19:13:00) [4]

Ищи по фразе "Там, где часики" (c)

---

Сергей М.   (2008-02-24 18:42:00) [5]

Никак.

В трее нет никаких "работающих прог", в трее есть просто иконки, которые те или иные "проги" там создают.

---

Наверх