Tray

← →
Zhker (2003-01-26 20:05) [0]

Я написал все функции с треем, все работает, убирается, появляется, сделал все команды, но вот проблема - я никак не могу сделать так, чтобы приложение убиралось при нажатии на конпку минимизации на окне - Form.OnHide не работает - как мне сделать, подскажите плиз

← →
Kane (2003-01-26 20:20) [1]

Tform1.Deactivate
Application.OnDeactivate

← →
Yrtimd (2003-01-26 20:37) [2]

Application.Minimize; {свернуть}
Application.MainForm.Hide; {скрыть}

← →
Романов Р.В. (2003-01-26 21:18) [3]

procedure TForm1.Timer1Timer(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_SHOW);
Application.MainForm.Show;
Timer1.Enabled := False;
end;

function TForm1.Hook(var Message : TMessage) : Boolean;
begin
if (Message.Msg = WM_SYSCOMMAND) and (Message.WParam and $FFF0 = SC_MINIMIZE) then
begin
Application.MainForm.Hide;
ShowWindow(Application.Handle, SW_HIDE);
Timer1.Enabled := True;
Result := True;
end
else
Result := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(Hook);
Timer1.Enabled := False;
Timer1.Interval := 5000;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Application.UnHookMainWindow(Hook);
end;

← →
Zhker (2003-01-26 21:30) [4]

Не помогло... поточнее нельзя написать, что куда вставлять ?

← →
Романов Р.В. (2003-01-26 21:39) [5]

Все что связано с таймером нужно выкинуть.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
public
function Hook(var Message : TMessage): Boolean;
end;

var
Form1: TForm1;

implementation

← →
Zhker (2003-01-26 22:04) [6]

Спасибо, все работает!

← →
Zhker (2003-01-26 22:42) [7]

Опять проблема, я все сделал (убирается при нажатии на минимизацию и т.д.) - но всплыла новая проблема - теперь при выключении программы появляется ее значок в трее, но если над ним поводить мышкой - он исчезнет - я уж и так и сяк пробовал - иконка все время упорно лезет в трей полсе закрытия проги. Как лечить ?

← →
Романов Р.В. (2003-01-26 22:45) [8]

А ты ее в OnClose убиваешь?

← →
Zhker (2003-01-27 00:18) [9]

Да, канешк, гляди :
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon (NIM_DELETE, @nid);
end;

← →
Юрий Зотов (2003-01-27 06:36) [10]

> Как лечить?
Заставить окно трея перерисоваться.
FindWindow + InvalidateRect + UpdateWindow

← →
Zhker (2003-01-27 15:59) [11]

Юрий, а как это написать ? Я InvalidateRect не знаю

← →
Cobalt (2003-01-27 22:49) [12]

Ну, Юра, у вас и щутки...
$)

← →
Юрий Зотов (2003-01-28 00:11) [13]

Ну, это не совсем шутка. Найти окно трея можно так:

Wnd := FindWindowEx(FindWindowEx(FindWindow("Shell_TrayWnd",
nil), 0, "TrayNotifyWnd", nil), 0, "ToolbarWindow32", nil);

А заставить его перерисоваться можно так же, как и любое другое окно:
InvalidateRect(Wnd, nil, True);
UpdateWindow(Wnd)

Другое дело, что пока не было вызвано
Shell_NotifyIcon (NIM_DELETE, ...)
эта перерисовка ничего не даст. А после того, как этот вызов был сделан, не нужна и перерисовка - трей сам перерисуется.

Короче говоря, вот полный код Tray Application. На форму надо бросить PopupMenu, а в нем создать 2 пункта - "Show" и "Exit".

type
TTrayForm = class(TForm)
TrayPopupMenu: TPopupMenu;
MenuItemShow: TMenuItem;
MenuItemExit: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure MenuItemShowClick(Sender: TObject);
procedure MenuItemExitClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FIconData: TNotifyIconData;
procedure WMUser(var Message: TMessage); message WM_USER;
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
end;

var
TrayForm: TTrayForm;

implementation

{$R *.DFM}

procedure TTrayForm.FormCreate(Sender: TObject);
begin
with Application, FIconData do
begin
ShowMainForm := False;
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
cbSize := SizeOf(FIconData);
Wnd := Self.Handle;
uID := 100;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
uCallbackMessage := WM_USER;
hIcon := Icon.Handle;
StrPCopy(szTip, Title)
end;
Shell_NotifyIcon(NIM_ADD, @FIconData)
end;

procedure TTrayForm.MenuItemShowClick(Sender: TObject);
begin
Show;
MenuItemShow.Enabled := False
end;

procedure TTrayForm.MenuItemExitClick(Sender: TObject);
begin
Close
end;

procedure TTrayForm.WMSysCommand(var Message: TWMSysCommand);
begin
if Message.CmdType and $FFF0 = SC_MINIMIZE then
begin
Hide;
MenuItemShow.Enabled := True
end
else inherited
end;

procedure TTrayForm.WMUser(var Message: TMessage);
var
P: TPoint;
begin
if Message.LParam = WM_RBUTTONDOWN then
begin
GetCursorPos(P);
SetForegroundWindow(Handle);
TrayPopupMenu.Popup(P.X, P.Y);
PostMessage(Handle, WM_NULL, 0, 0)
end
end;

procedure TTrayForm.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @FIconData)
end;

← →
Zhker (2003-01-29 23:47) [14]

Юрий, у меня все получилось, все работает, ничего не остается, но вот такая проблема - при создании у меня есть окно, в трее ничего нет, на панели задач - окошко программы, я сворачиваю программу, пояляется иконка в трее, убирается программа с панели задач. Вызываю попап меню и нажимаю "Показать окно" - убирается иконка в трее, но окошко программы на панели задач не появляется, и хоть убей у меня ничего не получается, я делал что-то типа :
procedure TForm1.Show1Click(Sender: TObject); begin ShowWindow (Handle, sw_ShowNormal); Show; Shell_NotifyIcon(NIM_DELETE, @FIconData); Show1.Enabled := False end;
Что делать ?

← →
Юрий Зотов (2003-01-30 09:13) [15]

1. Уберите строки:

ShowMainForm := False;
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);

2. Видимостью формы и окна на панели задач управляйте вручную:

Show;
ShowWindow(Application.Handle, SW_SHOW);

Hide;
ShowWindow(Application.Handle, SW_HIDE);

← →
Романов Р.В. (2003-01-30 09:44) [16]

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

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