работа в трее

← →
Рустам (2008-02-24 18:35) [0]

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

← →
Сергей М. © (2008-02-24 18:42) [1]

Никак.

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

← →
Johnmen © (2008-02-24 19:13) [2]

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

← →
Dark © (2008-02-24 20:30) [3]

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

← →
md10 (2008-02-25 12:04) [4]

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.

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

работа в трее Найти похожие ветки