لماذا لا يختفي أيقون البرنامج بعد أن يغلق البرنامج

[SALAH]

استعملت كود يا اخوة لكي اجعل أيقونة البرنامج بجانب الساعة ولكن عندما أغلق البرنامج لا تذهب الأيقونة بل تبقى واذا شغلت البرنامج 10 مرات أحصل على 10 من الأيقونات تخيلوا شريط المهام كيف يكون
وهذا هو الكود الذي استعملته :

unit main;

interface

uses
Windows, SHellApi,Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
const
NIF_INFO = $10;
NIF_MESSAGE = 1;
NIF_ICON = 2;
NOTIFYICON_VERSION = 3;
NIF_TIP = 4;
NIM_SETVERSION = $00000004;
NIM_SETFOCUS = $00000003;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;

NIN_BALLOONSHOW = WM_USER + 2;
NIN_BALLOONHIDE = WM_USER + 3;
NIN_BALLOONTIMEOUT = WM_USER + 4;
NIN_BALLOONUSERCLICK = WM_USER + 5;
NIN_SELECT = WM_USER + 0;
NINF_KEY = $1;
NIN_KEYSELECT = NIN_SELECT or NINF_KEY;


{other constants can be found in vs.net---vc7's dir: PlatformSDK\Include\ShellAPI.h}

{define the callback message}
TRAY_CALLBACK = WM_USER + $7258;

{new NotifyIconData structure definition}
type
PNewNotifyIconData = ^TNewNotifyIconData;
TDUMMYUNIONNAME = record
case Integer of
0: (uTimeout: UINT);
1: (uVersion: UINT);
end;

TNewNotifyIconData = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
//Version 5.0 is 128 chars, old ver is 64 chars
szTip: array [0..127] of Char;
dwState: DWORD; //Version 5.0
dwStateMask: DWORD; //Version 5.0
szInfo: array [0..255] of Char; //Version 5.0
DUMMYUNIONNAME: TDUMMYUNIONNAME;
szInfoTitle: array [0..63] of Char; //Version 5.0
dwInfoFlags: DWORD; //Version 5.0
end;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
IconData: TNewNotifyIconData;
procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
procedure AddSysTrayIcon;
procedure ShowBalloonTips;
procedure DeleteSysTrayIcon;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.SysTrayIconMsgHandler(var Msg: TMessage);
begin
case Msg.lParam of
WM_MOUSEMOVE:;
WM_LBUTTONDOWN:;
WM_LBUTTONUP:;
WM_LBUTTONDBLCLK:;
WM_RBUTTONDOWN:;
WM_RBUTTONUP:;
WM_RBUTTONDBLCLK:;
//followed by the new messages
NIN_BALLOONSHOW:
{Sent when the balloon is shown}
ShowMessage('NIN_BALLOONSHOW');
NIN_BALLOONHIDE:
{Sent when the balloon disappears?Rwhen the icon is deleted,
for example. This message is not sent if the balloon is dismissed because of
a timeout or mouse click by the user. }
ShowMessage('NIN_BALLOONHIDE');
NIN_BALLOONTIMEOUT:
{Sent when the balloon is dismissed because of a timeout.}
ShowMessage('NIN_BALLOONTIMEOUT');
NIN_BALLOONUSERCLICK:
{Sent when the balloon is dismissed because the user clicked the mouse.
Note: in XP there's Close button on he balloon tips, when click the button,
send NIN_BALLOONTIMEOUT message actually.}
ShowMessage('NIN_BALLOONUSERCLICK');
end;
end;

{AddSysTrayIcon procedure add an icon to notification area}
procedure TForm1.AddSysTrayIcon;
begin
IconData.cbSize := SizeOf(IconData);
IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler);
{SysTrayIconMsgHandler is then callback message' handler}
IconData.uID := 0;
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallbackMessage := TRAY_CALLBACK; //user defined callback message
IconData.hIcon := Application.Icon.Handle; //an Icon's Handle
IconData.szTip := 'Please send me email.';
if not Shell_NotifyIcon(NIM_ADD, @IconData) then
ShowMessage('add fail');
end;

{ShowBalloonTips procedure carry out the new feature: Balloon Tips}
procedure TForm1.ShowBalloonTips;
var
TipInfo, TipTitle: string;
begin
IconData.cbSize := SizeOf(IconData);
IconData.uFlags := NIF_INFO;
TipInfo := 'you welcome';
strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1);
IconData.DUMMYUNIONNAME.uTimeout := 3000;
TipTitle := 'www.delphi4arab.com';
strPLCopy(IconData.szInfoTitle, TipTitle, SizeOf(IconData.szInfoTitle) - 1);
IconData.dwInfoFlags := NIIF_INFO; //NIIF_ERROR; //NIIF_WARNING;
Shell_NotifyIcon(NIM_MODIFY, @IconData);
{in my testing, the following code has no use}
IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then
ShowMessage('setversion fail');
end;

{here's the deletion procedure}
procedure TForm1.DeleteSysTrayIcon;
begin
DeallocateHWnd(IconData.Wnd);
if not Shell_NotifyIcon(NIM_DELETE, @IconData) then
ShowMessage('delete fail');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
AddSysTrayIcon;
ShowBalloonTips;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteSysTrayIcon;
end;

end.




http://www7.0zz0.com/2008/05/15/17/863438975.jpg (http://www.0zz0.com)

[B.M.AbdelAziZ]

كما اضفت الايقونة عليك بحذفها عند غلق برنامجك
مثلا يمكنك ان تستدعي DeleteSysTrayIcon المذكورة فوق في الحدث OnClose لل Form

والسلام عليكم ورحمة الله

[SALAH]

لم أنجح سيدي فهلا فصلت قليلا فالكود السابق أخذته بدون أن أفهمه جيدا للأسف

[B.M.AbdelAziZ]

ارفق محاولتك ليتم الاطلاع عليها و تصحيحيها

[SALAH]

نعم وشكرا لك على الاهتمام

[SALAH]

سلام أحباب هذه هي مشاركتي:
مع المرفق

[مهدي]

عليك بإضافة الحدث OnDestroy و إدراج الإجراء التالي


procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @TrayIconData);
end;

[SALAH]

بارك الله فيك وفي علمك
جزاك الله خيرا وللأخ DeltaAziz