Баги при спользовании иконок в Области уведомления(systray)

← →
EvilIJ © (2006-04-21 13:56) [0]

Ребята, подскажите кто-н:
Создал компонент TIJTrayIcon, все работает замечательно и на много быстрее чем скажем TCoolTrayIcon, т.к. я не ломаю свой app во время выполнения программы, а использую WinApi. Все это хорошо, но при выключении компьютера (ENDSESSION) или при смене пользователя, моя прога не дает компу выключиться.
Я поковырял коды, отловил QUERY- и END- SESSION, программу выключаю, а винда все равно не тухнет :( . Пробывал даже рабочему столу эти сообщения посылать - тщетно. Что делать?
Как ПРАВИЛЬНО все завершить? Заранее, спасибо.

← →
Юрий Зотов © (2006-04-21 14:29) [1]

Что отвечает компонент на сообщение WM_QUERYENDSESSION?

← →
EvilIJ © (2006-04-21 15:55) [2]

В настоящее время компонент просто вызывает метод OnQueryEndSession и ничего в систему не отдает.
Я пока еще не проверял, но друзья говорят, что язабыл про PostQuitMessage(0) :), хотя, может и нет...

Кстати, у CoolTrayIcon та же проблема :)))))))))

← →
Юрий Зотов © (2006-04-21 16:21) [3]

Чей метод OnQueryEndSession вызывает компонент? Как реализован этот метод?

Ничего не отдавать в систему невозможно. Даже если сообщение не обрабатывается, какой-то результат оно все равно имеет, пусть даже случайный. И в данном случае небезразлично, что это за результат.

Поэтому важно ТОЧНО знать, как он формируется. Нужны детали. Лучше всего - полный код компонента.

← →
EvilIJ © (2006-04-24 08:43) [4]

Скорее всего, дело не в компоненте, а в программе его использующей...
С PostQuitMessage(0) та же бадяга... Хотя, если хочешь, мне не жаль компонента, я могу его тебе скинуть, только, пожалуйста, пообещай найти решение... (Напрягает вставлять halt внутрь компонента :))) )

← →
EvilIJ © (2006-04-24 08:47) [5]

(Я не нашел твоего почт. ящика, поэтому скинь мне запросик на EvilIJ@mail.ru а я тебе отвечу посылкой с вложенным архивом)

← →
Юрий Зотов © (2006-04-24 12:22) [6]

> EvilIJ © (24.04.06 08:43) [4]

> Скорее всего, дело не в компоненте, а в программе его использующей...
То есть, как раз в компоненте.

> мне не жаль компонента, я могу его тебе скинуть
Спасибо, мне он не нужен - но почему бы не выложить его здесь?

> только, пожалуйста, пообещай найти решение...
Его даже и искать не надо, оно и без поисков известно. Вопрос лишь в том, годен ли компонент для него в принципе своем - то есть, правильно ли он вообще спроектирован.

← →
EvilIJ © (2006-04-24 12:37) [7]

Вопрос: как выложить компонент?
Если пасовский модуль кидаешь - говорят: слишком много символов.
PS Может почтой лучше?

← →
Юрий Зотов © (2006-04-24 12:46) [8]

Разбейте код на несколько сообщений.

← →
EvilIJ © (2006-04-24 12:48) [9]

unit IJTrayIcon;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
ShellAPI, menus;

const UWM_TRAYICON = WM_USER+1024;
{$WARN SYMBOL_DEPRECATED OFF}
type
TIJTrayIcon = class(TComponent)
private
{ Private declarations }
FIcon: TIcon;
FHint: TCaption;
FShowHint: boolean;
FLeftPopup: boolean;
FPopupMenu: TPopupMenu;
data:TNotifyIconData;
FVisible: boolean;
FOnClick,
FOnDblClick,
FOnEndSession,
FOnQueryEndSession: TNotifyEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseDown,
FOnMouseUp: TMouseEvent;

Procedure SetIcon(Value: TIcon);
Procedure SetVisible(Value: boolean);
Procedure SetHint(Value: TCaption);
Procedure SetShowHint(Value: boolean);
function GetClientIconPos(P: TPoint): TPoint;
Procedure IconChanged(Sender: TObject);
protected
{ Protected declarations }
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
public
{ Public declarations }
procedure Show;
procedure Hide;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure TrayDefaultHandler (var Message:TMessage);
procedure Refresh;
published
{ Published declarations }
property Icon: TIcon read FIcon write SetIcon stored true;
property Visible: boolean read FVisible write SetVisible;
property Hint: TCaption read FHint write SetHint;
property ShowHint: boolean read FShowHint write SetShowHint;
property LeftPopup: boolean read FLeftPopup write FLeftPopup;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnEndSession: TNotifyEvent read FOnEndSession write FOnEndSession;
property OnQueryEndSession: TNotifyEvent read FOnQueryEndSession write FOnQueryEndSession;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
end;

← →
EvilIJ © (2006-04-24 12:48) [10]

procedure Register;

implementation

procedure Register;
begin
RegisterComponents("IJ Components", [TIJTrayIcon]);
end;
//////////////////////////////////////////////////////////////////////////////////////////
constructor TIJTrayIcon.Create(AOwner: TComponent);
var H: THandle;
begin
inherited Create(AOwner);
FIcon:=TIcon.Create;

if not(csDesigning in ComponentState) then
begin
H:=AllocateHWnd(TrayDefaultHandler);
data.cbSize:=SizeOf (DATA);
data.Wnd:=H;
data.uCallbackMessage:=UWM_TRAYICON;
data.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
Icon:=Application.Icon;
end;
end;
//////////////////////////////////////////////////////////////////////////////////////////
destructor TIJTrayIcon.Destroy;
begin
Shell_NotifyIcon (NIM_DELETE,@data);
FIcon.Free;
inherited Destroy;
end;
//////////////////////////////////////////////////////////////////////////////////////////
procedure TIJTrayIcon.TrayDefaultHandler (var Message:TMessage);
var Pt, p: TPoint;
Shift: TShiftState;
function ShiftState: TShiftState;
// Return the state of the shift, ctrl, and alt keys
begin
Result := [];
if GetAsyncKeyState(VK_SHIFT) < 0 then
Include(Result, ssShift);
if GetAsyncKeyState(VK_CONTROL) < 0 then
Include(Result, ssCtrl);
if GetAsyncKeyState(VK_MENU) < 0 then
Include(Result, ssAlt);
end;
begin
if Message.Msg = WM_ENDSESSION then
begin
if Assigned(FOnEndSession) then
FOnEndSession(Self);
end;
if Message.Msg = WM_QUERYENDSESSION then
begin
if Assigned(FOnQueryEndSession) then
FOnQueryEndSession(Self);
end;
if Message.Msg=UWM_TRAYICON then
begin
case Message.LParam of
WM_LBUTTONDOWN: begin
GetCursorPos(Pt);
Shift := ShiftState + [ssLeft];
p:=GetClientIconPos(pt);
MouseDown(mbLeft, Shift, p.X, p.Y);
if FLeftPopup then
if FPopupMenu<>nil then
FPopupMenu.Popup(pt.X, pt.Y);
end;
WM_LBUTTONUP: begin
GetCursorPos(Pt);
Shift := ShiftState + [ssLeft];
p:=GetClientIconPos(pt);
MouseUp(mbLeft, Shift, p.X, p.Y);
Click;
end;
WM_RBUTTONDOWN: begin
GetCursorPos(Pt);
Shift := ShiftState + [ssRight];
p:=GetClientIconPos(pt);
MouseDown(mbRight, Shift, p.X, p.Y);
end;
WM_RBUTTONUP: begin
GetCursorPos(Pt);
Shift := ShiftState + [ssRight];
p:=GetClientIconPos(pt);
MouseUp(mbRight, Shift, p.X, p.Y);
if FPopupMenu<>nil then
FPopupMenu.Popup(pt.X, pt.Y);
end;
WM_LBUTTONDBLCLK: begin
DblClick;
end;
WM_MOUSEMOVE: begin
GetCursorPos(Pt);
Shift := ShiftState + [ssRight];
p:=GetClientIconPos(pt);
MouseMove(Shift, p.X, p.Y);
end;
end;

end;
end;
///////////////////////////////////////////////////
procedure TIJTrayIcon.Refresh;
begin
if not(csDesigning in ComponentState) then
if FVisible then
begin
data.hIcon:=FIcon.Handle;
StrPCopy(data.szTip,FHint);
Shell_NotifyIcon (NIM_MODIFY,@data);
end;
end;
//////////////////////////////////////////////////////////////////////////////////////////
Procedure TIJTrayIcon.SetVisible(Value: boolean);
begin
FVisible:=Value;
if FVisible then Show else
Hide;
end;
////////////////////////////////////////////////////////////////////////////////
Procedure TIJTrayIcon.Show;
begin
if not(csDesigning in ComponentState) then
begin
FVisible:=true;
Shell_NotifyIcon (NIM_ADD,@data);
Refresh;
end;
end;

← →
EvilIJ © (2006-04-24 12:48) [11]

////////////////////////////////////////////////////////////////////////////////
Procedure TIJTrayIcon.Hide;
begin
if not(csDesigning in ComponentState) then
begin
FVisible:=False;
Shell_NotifyIcon (NIM_DELETE,@data);
Refresh;
end;
end;
////////////////////////////////////////////////////////////////////////////////
Procedure TIJTrayIcon.SetIcon(Value: TIcon);
begin
FIcon.OnChange := nil;
FIcon.Assign(Value);
FIcon.OnChange := IconChanged;
data.hIcon:=FIcon.Handle;
Refresh;
end;
////////////////////////////////////////////////////////////////////////////////
Procedure TIJTrayIcon.SetHint(Value: TCaption);
begin
if Length(Value)>63 then
Value:=Copy(Value, 1, 63);
FHint:=Value;
Refresh;
end;
////////////////////////////////////////////////////////////////////////////////
Procedure TIJTrayIcon.SetShowHint(Value: boolean);
begin
FShowHint:=Value;
if FShowHint then
data.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE else
data.uFlags:=NIF_ICON or NIF_MESSAGE;
Refresh;
end;
////////////////////////////////////////////////////////////////////////////////
function TIJTrayIcon.GetClientIconPos(P: TPoint): TPoint;
// Return the cursor position inside the tray icon
const
IconBorder = 1;
var
H: HWND;
IconSize: Integer;
begin
// Get the icon size
IconSize := GetSystemMetrics(SM_CYCAPTION) - 3;
//!!!!!! ПОИСК ОКНА ПОД КУРСОРОМ!!!!!!
H := WindowFromPoint(P);
{ Convert current cursor X,Y coordinates to tray client coordinates.
Add borders to tray icon size in the calculations. }
Windows.ScreenToClient(H, P);
P.X := (P.X mod ((IconBorder*2)+IconSize)) -1;
P.Y := (P.Y mod ((IconBorder*2)+IconSize)) -1;
Result := P;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TIJTrayIcon.Click;
begin
if Assigned(FOnClick) then
FOnClick(Self);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TIJTrayIcon.DblClick;
begin
if Assigned(FOnDblClick) then
FOnDblClick(Self);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TIJTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Assigned(FOnMouseDown) then
FOnMouseDown(Self, Button, Shift, X, Y);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TIJTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, Button, Shift, X, Y);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TIJTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if Assigned(FOnMouseMove) then
FOnMouseMove(Self, Shift, X, Y);
end;
////////////////////////////////////////////////////////////////////////////////
Procedure TIJTrayIcon.IconChanged(Sender: TObject);
begin
Refresh;
end;
////////////////////////////////////////////////////////////////////////////////
end.

← →
SuperBug © (2006-04-24 18:55) [12]

В общем может я ошибаюсь,но при внимательном изучении хэлпа написано,что события типа WM_QUERYENDSESSION, WM_ENDSESSION должны возвращать результат,что приложение события отработало и нормально закрывается ,т.е. после вызова обработчиков неплохо было б написать Message.Result:=Integer(True);

что-то типа
if Message.Msg = WM_QUERYENDSESSION then begin if Assigned(FOnQueryEndSession) then FOnQueryEndSession(Self); Message.Result:=Integer(True); end;

← →
EvilIJ © (2006-04-25 08:19) [13]

Спасибо ребята, но увы, код не работает... (((
Может, еще какие предложения?

← →
SuperBUG © (2006-04-25 17:24) [14]

Признаю свою вину,меру , степень ,глубину.....
Итого результат изысканий на тему (проверено для W2k,WinNT)

1.Для приличия заводим данному компоненту Handle
в секции Private FHandle: THandle;
2.для constructor TIJTrayIcon.Create(AOwner: TComponent);
соответственно меняем строчку

FHandle:=AllocateHWnd(TrayDefaultHandler);
......
data.Wnd:=FHandle;
.....

3. в деструкторе destructor TIJTrayIcon.Destroy после
.....
Shell_NotifyIcon (NIM_DELETE,@data);
добавляем
DeallocateHWND(FHandle)
ибо ресурсы надо возвращать....

4. в procedure TIJTrayIcon.TrayDefaultHandler (var Message:TMessage)
создаем вместо множества if...then конструкцию case Msg.Message of
удаляем нафиг все QueryEndSession, оставляем только UWM_TRAYICON
т.е. имеем что-то типа
case Msg.Message of UWM_TRAYICON:begin end else with Msg do Result:=DefWindowHandler(FHandle,Msg,wParam,lParam); end;

Собственно и все.

← →
SuperBUG © (2006-04-25 17:27) [15]

точнее
case Msg.Message of UWM_TRAYICON:begin ..... {весь тот код что и раньше} ..... end else with Msg do Result:=DefWindowHandler(FHandle,Msg,wParam,lParam); end;

← →
EvilIJ © (2006-04-26 14:06) [16]

Если честно, даже стыдно (на счет того, что я хэндл иконки не глобально объявил)...
Вроде бы все вставил... увы одно НО )
ЧТО ЕСТЬ DefWindowHandler?
Вместо нее я пока вставил
... else
with Message do
Result:= DefWindowProc(FHandle,Msg,wParam,lParam);
Может у меня что с руками или бага в генах ??? ))))

← →
EvilIJ © (2006-04-26 14:07) [17]

Но винда все равно не гаснет (2000)

гмммм......насчет DefWindowProc-она и была,это у меня ошибка пальцев :( слушай,м.б. кинешь мне на мыло тестовый ехешник? у меня просто в таком варианте не только 2к гаснет,но и NT,которая куда более привередливая или могу тебе заслать свой,и ты мне скажешь работает или нет...а то чего-то непонятное...

Получи, распишись)

Вот компонент, который ничему не мешает (проверялось под XP). Сравните со своим, найдете причину.

unit YzTrayIcon; interface uses Windows, ShellAPI, Messages, SysUtils, Classes, Graphics; type TYzTrayIcon = class; TChangeReason = (crHint, crIcon, crVisible); TChangeEvent = procedure(Sender: TYzTrayIcon; Reason: TChangeReason) of object; TYzTrayIcon = class(TComponent) private FData: TNotifyIconData; FIcon: TIcon; FVisible: boolean; FOnChange: TChangeEvent; FOnDblClick: TNotifyEvent; function GetHandle: THandle; function GetHint: string; procedure SetHint(const Value: string); procedure SetIcon(const Value: TIcon); procedure SetVisible(const Value: boolean); procedure IconChange(Sender: TObject); protected procedure Changed(Reason: TChangeReason); procedure Change(Reason: TChangeReason); dynamic; procedure DblClick; dynamic; procedure WndProc(var Message: TMessage); dynamic; procedure Loaded; override; property Handle: THandle read GetHandle; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Hint: string read GetHint write SetHint; property Icon: TIcon read FIcon write SetIcon; property Visible: boolean read FVisible write SetVisible default True; property OnChange: TChangeEvent read FOnChange write FOnChange; property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; end; implementation uses ComObj; var TrayIcon: TYzTrayIcon; { TYzTrayIcon } procedure TYzTrayIcon.Change(Reason: TChangeReason); begin if Assigned(FOnChange) then FOnChange(Self, Reason) end; procedure TYzTrayIcon.Changed(Reason: TChangeReason); const NIM_MSG: array[boolean] of cardinal = (NIM_DELETE, NIM_ADD); begin if [csDesigning, csLoading] * ComponentState = [] then if Reason = crVisible then Shell_NotifyIcon(NIM_MSG[FVisible], @FData) else Shell_NotifyIcon(NIM_MODIFY, @FData); Change(Reason) end; constructor TYzTrayIcon.Create(AOwner: TComponent); begin if TrayIcon <> nil then raise Exception.Create("Component TYzTrayIcon already exists"); inherited; TrayIcon := Self; FVisible := True; FIcon := TIcon.Create; FIcon.OnChange := IconChange; if not (csDesigning in ComponentState) then with FData do begin cbSize := SizeOf(FData); Wnd := AllocateHWnd(WndProc); uID := RegisterWindowMessage("TYzTrayIcon_CallbackMessage"); uFlags := NIF_MESSAGE; uCallbackMessage := uID end end; procedure TYzTrayIcon.DblClick; begin if Assigned(FOnDblClick) then FOnDblClick(Self) end; destructor TYzTrayIcon.Destroy; begin Visible := False; DeallocateHWnd(Handle); FIcon.Free; TrayIcon := nil; inherited end; function TYzTrayIcon.GetHandle: THandle; begin Result := FData.Wnd end; function TYzTrayIcon.GetHint: string; begin Result := FData.szTip end; procedure TYzTrayIcon.IconChange(Sender: TObject); begin with FData do begin hIcon := FIcon.Handle; if FIcon.Empty then uFlags := uFlags and not NIF_ICON else uFlags := uFlags or NIF_ICON end; Changed(crIcon) end; procedure TYzTrayIcon.Loaded; begin inherited; if FVisible then Changed(crVisible) end; procedure TYzTrayIcon.SetHint(const Value: string); begin if Hint <> Value then with FData do begin if Length(Value) > High(szTip) then raise Exception.Create("Too long hint"); StrPCopy(szTip, Value); if Hint = "" then uFlags := uFlags and not NIF_MESSAGE else uFlags := uFlags or NIF_MESSAGE; Changed(crHint) end end; procedure TYzTrayIcon.SetIcon(const Value: TIcon); begin FIcon.Assign(Value) end; procedure TYzTrayIcon.SetVisible(const Value: boolean); begin if FVisible <> Value then begin FVisible := Value; Changed(crVisible) end end; procedure TYzTrayIcon.WndProc(var Message: TMessage); begin with Message do if Msg = FData.uCallbackMessage then begin Result := 0; case LParam of WM_LBUTTONDBLCLK: DblClick; // ... (another messages and handlers) end end else Result := DefWindowProc(Handle, Msg, WParam, LParam) end; end.

PS
Чтобы не засорять код несущественными деталями, комонент сделан минимальным. Он умеет только показывать/прятать иконку в SysTray и уведомлять о двойном клике по ней. Прочую функциональность добавьте сами.

C Вашим кодом та же фигня, походу, всетаки дело не в компоненте...
EvilIJ © (24.04.06 08:43) [4]
Надо ковырять саму программу...
Если интересно, ту же прогу я написал на VC6.0 и такой проблемы НЕБЫЛО.
эх...

)))))) И все же решение нашлось, хотя и "не правильное" ))))
Сообщения WM_END.. и Q... я отловил в самой программе(не в компоненте) и вместо CLOSE (так было раньше) вставил HALT.))))) ВСЕ ПУЧКОМ )))
Кстати, я забыл сказать, что главное окно моей программы прячится "в трэй",
возможно, виндуза просто не могла до него долесть, ведь в дельфях "главная" форма все равно сидит под Application, а у него есть свой хэндл. А в WndProc Application-а я не лазил, кто знает, что там )
\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\
Все равно всем спасибо, это мой первый форум, было интересно )
С уважением, IJ...

← →
Nostradamus (2006-04-27 19:21) [24]

У тебя в OnClose скорее всего написано что-то типа
CanClose := False; Hide;

Чтобы сворачивать пргу в трей.

Если убрать CanClose := False;, то винда будет выключаться

Баги при спользовании иконок в Области уведомления(systray) Найти похожие ветки