قرار دادن آیکون برنامه را در Tray (در کنار ساعت سیستم) ؟

[hadavinia]

چگونه می توان بر نامه را به سمت راست تسکبار کنار ساعت انتقال داد
همچون برنامه بابیلون و ...

[مهدی کرامتی]

این کد حاوی کامپوننتی بنام TrayIcon است که دارای تعدادی مشخصه و Event میباشد که بوسیله آنها میتوانید علاوه بر قرار دادن آیکن در Tray و تعیین متن ToolTip برای آن، وقایع دریافتی از جمله Click ، DoubleClick و RightClick را نیز بعنوان Event دریافت کنید.

برای نصب کامپوننت کافی است از فولدر Delphi\Lib فایل dclusr70.dpk (در دلفی 7) را باز کرده و این یونیت را به آن اضافه کنید. سپس روی دکمه Compile و سپس Install کلیک کنید. فراموش نکنید این یونیت را در محلی که در دسترسی Search Path دلفی باشد (مثلا همان فولدر Delphi\Lib) قرار دهید.

نکته: این کامپوننت بهمراه Novin VCL 3.0 بزودی از طرف نوین رسانه (http://www.novinmedia.com) عرضه خواهد شد:


unit TrayIcon;
interface

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

const WM_TOOLTRAYICON = WM_USER+1;
WM_RESETTOOLTIP = WM_USER+2;

type
TTrayIcon = class(TComponent)
private
{ Field Variables }
IconData: TNOTIFYICONDATA;
fIcon : TIcon;
fToolTip : String;
fWindowHandle : HWND;
fActive : boolean;
fShowDesigning : Boolean;
{ Events }

fOnClick : TNotifyEvent;
fOnDblClick : TNotifyEvent;
fOnRightClick : TMouseEvent;

function AddIcon : boolean;
function ModifyIcon : boolean;
function DeleteIcon : boolean;

procedure SetActive(Value : boolean);
procedure SetShowDesigning(Value : boolean);
procedure SetIcon(Value : TIcon);
procedure SetToolTip(Value : String);
procedure WndProc(var msg : TMessage);

procedure FillDataStructure;
protected
constructor create(aOwner : TComponent); override;
destructor destroy; override;
public
published
property Active : boolean read fActive write SetActive;
property ShowDesigning : boolean read fShowDesigning write SetShowDesigning;
property Icon : TIcon read fIcon write SetIcon;
property ToolTip : string read fTooltip write SetToolTip;

property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
property OnRightClick : TMouseEvent read FOnRightClick write FonRightClick;
end;

procedure Register;

implementation


procedure TTrayIcon.SetActive(Value : boolean);
begin
if value <> fActive then begin
fActive := Value;
if not (csdesigning in ComponentState) then begin
if Value then begin
AddIcon;
end else begin
DeleteIcon;
end;
end;
end;
end;

procedure TTrayIcon.SetShowDesigning(Value : boolean);
begin
if csdesigning in ComponentState then begin
if value <> fShowDesigning then begin
fShowDesigning := Value;
if Value then begin
AddIcon;
end else begin
DeleteIcon;
end;
end;
end;
end;

procedure TTrayIcon.SetIcon(Value : Ticon);
begin
if Value <> fIcon then
begin
fIcon.Assign(value);
ModifyIcon;
end;
end;

procedure TTrayIcon.SetToolTip(Value : string);
begin

// This routine ALWAYS re-sets the field value and re-loads the
// icon. This is so the ToolTip can be set blank when the component
// is first loaded. If this is changed, the icon will be blank on
// the TRAY when no ToolTip is specified.

if length( Value ) > 62 then
Value := copy(Value,1,62);
fToolTip := value;
ModifyIcon;
end;

constructor TTrayIcon.Create(aOwner : TComponent);
begin
inherited create(aOwner);
FWindowHandle := AllocateHWnd( WndProc );
FIcon := TIcon.Create;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

destructor TTrayIcon.destroy;
begin
if (not (csDesigning in ComponentState) and fActive)
or ((csDesigning in ComponentState) and fShowDesigning) then
DeleteIcon;

FIcon.Free;
DeAllocateHWnd( FWindowHandle );
inherited destroy;
end;

procedure TTrayIcon.FillDataStructure;
begin
with IconData do
begin
cbSize := sizeof(TNOTIFYICONDATA);
wnd := FWindowHandle;
uID := 0; // is not passed in with message so make it 0
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
hIcon := fIcon.Handle;
StrPCopy(szTip,fToolTip);
uCallbackMessage := WM_TOOLTRAYICON;
end;
end;

function TTrayIcon.AddIcon : boolean;
begin
FillDataStructure;
result := Shell_NotifyIcon(NIM_ADD,@IconData);

// For some reason, if there is no tool tip set up, then the icon
// doesn't display. This fixes that.

if fToolTip = '' then
PostMessage( fWindowHandle, WM_RESETTOOLTIP,0,0 );
end;

function TTrayIcon.ModifyIcon : boolean;
begin
FillDataStructure;
if fActive then
result := Shell_NotifyIcon(NIM_MODIFY,@IconData)
else
result := True;
end;

function TTrayIcon.DeleteIcon : boolean;
begin
result := Shell_NotifyIcon(NIM_DELETE,@IconData);
end;

procedure TTrayIcon.WndProc(var msg : TMessage);
var MouseCo: TPoint;
begin
with msg do
if (msg = WM_RESETTOOLTIP) then
SetToolTip( fToolTip )
else if (msg = WM_TOOLTRAYICON) then
begin
case lParam of
WM_LBUTTONDBLCLK: if assigned (FOnDblClick) then FOnDblClick
(self);
WM_LBUTTONUP : if assigned(FOnClick)then FOnClick(self);
WM_RBUTTONUP : if assigned (FOnRightClick)then
begin
GetCursorPos(MouseCo);
FOnRightClick(self,mbRight,[],
MouseCo.x, MouseCo.y);
end;
end;
end
else // Handle all messages with the default handler
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure Register;
begin
RegisterComponents('Novin System Tools', [TTrayIcon]);
end;

end.

[ara_prg]

البته خودت هم به راحتی میتوانی با دستور Shell_NotifyIcon این کار را انجام بدهی زیرا این کار نیاز به هیچ کامپوننتی ندارد و کل کار را خودت Manage خواهی کرد :wink:

[nasr]

این آیکون با بستن برنامه هم حذف میشه
آیا میشه این آیکون را همیشه اینجا قرار داد
ممنون

[SalarSoft]

این آیکون با بستن برنامه هم حذف میشه
آیا میشه این آیکون را همیشه اینجا قرار داد
برای این کار باید کار های مر بوط به اظافه کردن آیکون به SysTray را در یک Dll انجام بدی! :)

[ara_prg]

بهتر است بگوئی که چه کاری می خواهی انجام دهی تا بگویم که چه کار کنی

همیشه هر کاری می شه :wink:

[MSK]

اگه تمام فرم های برنامت رو hide کنی بنظر می رسه برنامت بسته شده ولی پروگرم اصلی برنامت در لیست
پروسس ها باقی می مونه و بسته نمی شه. اونوقت می تونی با کمی تلاش رسیدگی به Event هاتو توی کد پروگرم اصلی بر عهده بگیری. :wink:

[orion188]

تازه میشه برنامه اصلا" فرم نداشته باشه! نه؟