هذا الكود يرجع رسالة خطأ access violation.
كما أنه ينبغي أن يحرر المكون عند الخروج من البرنامج حتى تختفي الإيقونة، وإذا أردت أن تستعمل ذاك كود عليك إضافة يلي:
أولا: لا بد من إضافة ShellAPI الى القائمة uses التي في الأعلى (تحت interface).
ثانيا: تعريف المكون SystrayIcon: TNotifyIconData فوق implementation حتى يُتوصل إليه من جميع الإجراءات.
ثالثا: عليك تحرير المكون عند إنتهاء البرنامج حتى تختفي الإيقونة، باستعمال الكود:
كود :
procedure TMain.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @SystrayIcon);
end;
كنت طورت بالأمس كود يعرض إيقونة بجنب ساعة المكتب، ويضيف إليها قائمة PopupMenu بثلاث أوامر (Afficher لعرف النافذة، Masquer لإخفائها، Quitter لغلق البرنامج)، عند تصغير النافذة تختفي من شريط المهام لتخزن في الإيقونة، ويمكن من خلاله إضافة أحداث للأيقونة (النقر بزر اليمين أو اليسار، النقر المزدوج، تمرير الماوس...)، وإليكم الكود سورس:
كود :
uses ShellApi;
...
private
procedure WMTaskMsg(var Msg: TMessage); message WM_APP + 100;
procedure WMSysCommand(var msg: TWMSysCommand); message WM_SysCommand;
...
var MyTNA: TNotifyIconData;
...
procedure TForm1.WMSysCommand(var msg: TWMSysCommand);
begin
if msg.CmdType and $FFF0 = SC_MINIMIZE then
Masquer1.Click
else
inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
with MyTNA do begin
cbSize := SizeOf(MyTNA);
Wnd := Handle;
uID := UINT(Self);
uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
uCallbackMessage := WM_APP + 100;{WM_USER + 1;//Pour défini par l'utilisateur: WM_USER + $7258;}
hIcon := Application.Icon.Handle; {Utiliser LoadIcon(HInstance, 'xxx') pour une icone dans les rescources}
szTip := 'Hint sur l''icône';
end;
Shell_NotifyIcon(NIM_ADD,@MyTNA);//Application.ShowMainForm := False;
end;
procedure TForm1.WMTaskMsg(var Msg: TMessage);
var CursorPoint: TPoint;
begin
if Msg.WParam = MyTNA.uID then
case Msg.LParam of
WM_LBUTTONDOWN: Masquer1.Click;//Bouton gauche click
WM_RBUTTONDOWN://Bouton droite click
begin
GetCursorPos(CursorPoint);
PopupMenu1.Popup(CursorPoint.X,CursorPoint.Y);
end;
WM_LBUTTONDBLCLK: Afficher1.Click; //Double click bouton gauche click
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE,@MyTNA);
end;
procedure TForm1.Afficher1Click(Sender: TObject);
var HndOwner: THandle;
begin
//Afficher la fenêtre Form1
SendMessage(Self.Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
ShowWindow(Self.Handle, SW_SHOW);
SetForegroundWindow(Self.Handle);
//Afficher dans la barre des tâches
HndOwner := GetWindow(Self.Handle, GW_OWNER);
SendMessage(HndOwner, WM_SYSCOMMAND, SC_RESTORE, 0);
ShowWindow(HndOwner, SW_SHOW);
end;
procedure TForm1.Masquer1Click(Sender: TObject);
begin
ShowWindow(Self.Handle, SW_HIDE);//Masquer Form1
ShowWindow(GetWindow(Self.Handle, GW_OWNER), SW_HIDE);//Masquer du TaskBar
end;
procedure TForm1.Quitter1Click(Sender: TObject);
begin
Close;
end;
