Удобные компоненты для работы в трее (бесплатные)

← →
korvin © (2004-12-03 17:33) [0]

Подскажите (если можно ссылочки) на компоненты для стискивания и работы моего приложения в трее. Чтоб всё как у людей: менюшки на обе клавиши мышки разные, подсказки, которые можно было бы вызывать программно и т.д.
Вобщем может у кого есть свои любимые. Было бы класно, если бы в комплекте с компонентом были примеры.
СпасибЫ!!!

← →
Начинающий2 (2004-12-03 18:25) [1]

Компоненты такие есть, и не мало. Задай в поисковике типа - Delphi*компоненты - , и найдёш то что ищеш. Также можно и с примером наити.

← →
Начинающий2 (2004-12-03 19:13) [2]

Если хочещ, можеш сам сделать компанент, вот исходник, щас нашол по адрессу: http://delphiworld.narod.ru/base/trayicon_comp.html

Компонент TrayIcon
--------------------------------------------------------------------------------

unit Trayicon;
interface
uses

SysUtils, Windows, Messages, Classes, Graphics, Controls, ShellAPI, Forms,
menus;
const
WM_TOOLTRAYICON = WM_USER + 1;

WM_RESETTOOLTIP = WM_USER + 2;
type

TTrayIcon = class(TComponent)
private
// BDS
{ для внутреннего пользования }
hMapping: THandle;
{ Набор переменных }
IconData: TNOTIFYICONDATA;
fIcon: TIcon;
fToolTip: string;
fWindowHandle: HWND;
fActive: boolean;
fShowApp: boolean; // Добавлено
fSendMsg: string;
fShowDesigning: Boolean;
{ События }
fOnClick: TNotifyEvent;
fOnDblClick: TNotifyEvent;
fOnRightClick: TMouseEvent;
fPopupMenu: TPopupMenu;
function AddIcon: boolean;
function ModifyIcon: boolean;
function DeleteIcon: boolean;
procedure SetActive(Value: boolean);
procedure SetShowApp(Value: boolean); // Добавлено
procedure SetShowDesigning(Value: boolean);
procedure SetIcon(Value: TIcon);
procedure SetToolTip(Value: string);
procedure WndProc(var msg: TMessage);
procedure FillDataStructure;
procedure DoRightClick(Sender: TObject);
protected
public
FMessageID: DWORD;
constructor create(aOwner: TComponent); override;
procedure Loaded; override; // Добавлено
destructor destroy; override;
procedure GoToPreviousInstance;
published
property Active: boolean read fActive write SetActive;
property ShowDesigning: boolean read fShowDesigning write
SetShowDesigning;

property Icon: TIcon read fIcon write SetIcon;
property IDMessage: string read fSendMsg write fSendMsg;
property ShowApp: boolean read fShowApp write SetShowApp; // Добавлено
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;

property PopupMenu: TPopupMenu read fPopupMenu write fPopupMenu;
end;

procedure Register;

type

PHWND = ^HWND;

implementation

{$R TrayIcon.res}

procedure TTrayIcon.GoToPreviousInstance;
begin

PostMessage(hwnd_Broadcast, fMessageID, 0, 0);
end;

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.SetShowApp(Value: boolean); // Добавлено
begin

if value <> fShowApp then
fShowApp := value;
if not (csdesigning in ComponentState) then
begin
if Value then
begin
ShowWindow(Application.Handle, SW_SHOW);
end
else
begin
ShowWindow(Application.Handle, SW_HIDE);
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

// Данная программа ВСЕГДА переустанавливает текст подсказки и перезагружает
// иконку. Текст может быть пустым в случае первой инициализации компонента.
// Без инициализации иконка будет пустой и текст подсказки будет отсутствовать.
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;
SetShowApp(False);
end;

destructor TTrayIcon.destroy;
begin

// BDS
CloseHandle(hMapping);

if (not (csDesigning in ComponentState) and fActive)
or ((csDesigning in ComponentState) and fShowDesigning) then
DeleteIcon;
FIcon.Free;
DeAllocateHWnd(FWindowHandle);
inherited destroy;
end;

procedure TTrayIcon.Loaded;
var

// BDS
// hMapping: HWND;
tmp, tmpID: PChar;
begin

inherited Loaded;
if fSendMsg <> "" then
begin
GetMem(tmp, Length(fSendMsg) + 1);
GetMem(tmpID, Length(fSendMsg) + 1);
StrPCopy(tmp, fSendMsg);
StrPCopy(tmpID, fSendMsg);
fMessageID := RegisterWindowMessage(tmp);
FreeMem(tmp);
hMapping := CreateFileMapping(HWND($FFFFFFFF), nil, PAGE_READONLY, 0, 32,
tmpID);
if (hMapping <> NULL) and (GetLastError = ERROR_ALREADY_EXISTS) then
begin
if not (csDesigning in ComponentState) then
begin
GotoPreviousInstance;
FreeMem(tmpID);
halt;
end;
end;
FreeMem(tmpID);
end;
SetShowApp(fShowApp);
end;

procedure TTrayIcon.FillDataStructure;
begin

with IconData do
begin
cbSize := sizeof(TNOTIFYICONDATA);
wnd := FWindowHandle;
uID := 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);
// По неизвестной причине, если не задан текст всплывающей
// подсказки, иконка не выводится. Здесь это учтено.
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;

procedure TTrayIcon.DoRightClick(Sender: TObject);
var
MouseCo: Tpoint;
begin

GetCursorPos(MouseCo);
if assigned(fPopupMenu) then
begin
SetForegroundWindow(Application.Handle);
Application.ProcessMessages;
fPopupmenu.Popup(Mouseco.X, Mouseco.Y);
end;
if assigned(FOnRightClick) then
begin
FOnRightClick(self, mbRight, [], MouseCo.x, MouseCo.y);
end;
end;

function TTrayIcon.DeleteIcon: boolean;
begin

result := Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

procedure TTrayIcon.WndProc(var msg: TMessage);
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: DoRightClick(self);
end;
end
else // Обработка всех сообщений с дескриптором по умолчанию
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure Register;
begin

RegisterComponents("Win95", [TTrayIcon]);
end;
end.

← →
Garfunkel (2004-12-04 00:22) [3]

TextTrayIcon
http://www3.ewebcity.com/troels/delphi.asp

freeware

мне нравится CoolTray http://www.delphipages.com/uploads/IconsandGlyphs/cooltray.zip
бесплатно и с исходниками под D5-D8

← →
Начинающий2 (2004-12-04 20:19) [5]

> Garfunkel (04.12.04 00:22) [3]

>TextTrayIcon
http://www3.ewebcity.com/troels/delphi.asp

Вообщето эта станица не работает.

Удобные компоненты для работы в трее (бесплатные) Найти похожие ветки