Почему не получается ? Вроде все как в форуме описывали...

← →
Lizard (2002-02-05 21:29) [0]

Хотел создать программку с иконкой в Tray с меню (по клику правой кнопки). Нашел ответ на свой вопрос в форуме, но не получается скомпилировать программу. Что я делаю не так ?
Описание в форуме :
-----------------------------------------------

как спрятать программу в трей

23 апр 2001 (понедельник), 09:32:34

Здравствуйте. Мне срочно нужно узнать, как спрятать программу в трей. И
как можно ею в нем управлять.
С уважением Владимир.

Ответить.

Ответ 1:
Самый простой вариант - использовать готовую компоненту.
Например из библиотеки RX - RxTrayIcon. Свойства и методы
очень понятны и без описания.
Ответ 2:
1. В Uses добавьте ShellAPI.
2. В public или private блоке Вашей формы укажите
Tr_Icon : TIcon;
TrayIcon: TNotifyIconData;
procedure OnMessage(var Msg: TMessage); virtual;
3. Используйте ImageList в качестве контейнера для иконок, которые Вы будете использовать в Трее.
4. Создайте Popup меню для команд доступных из трея.
5. Теперь в FormCreate Вы должны выполнить следующее
FillChar(TrayIcon, SizeOf(TrayIcon), 0);
Tr_Icon := TIcon.Create; //Создаем иконку
IconsList.GetIcon(0, Tr_Icon); //и загружаем ее из ImageList

TrayIcon.cbSize:=SizeOf(TrayIcon);
TrayIcon.Wnd:=AllocateHwnd(OnMessage); // My Proc OnMessage
TrayIcon.HIcon:=Tr_Icon.Handle;
StrPLCopy(TrayIcon.szTip, Application.Title, SizeOf(TrayIcon.szTip)-1);
TrayIcon.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
TrayIcon.uCallbackMessage:=Wm_Callback_Msg;
Shell_NotifyIcon(NIM_ADD, @TrayIcon); // ВСЕ!!! Мы создали иконку в трее
6. В FormDestroy добавляем строку
Shell_NotifyIcon(NIM_DELETE, @TrayIcon);

7. Нам осталось описать процедуру onMessage

procedure TForm1.OnMessage(var Msg: TMessage);
procedure ShowPopup;
var
x, y : integer;
begin
x := GetSystemMetrics(SM_CXFULLSCREEN);
y := GetSystemMetrics(SM_CYFULLSCREEN) + GetSystemMetrics(SM_CYCAPTION);
PopupMenu1.Popup(x, y)
end;
begin
case Msg.Msg of
procedure TGepardManagerForm.OnMessage(var Msg: TMessage);
begin
case Msg.Msg of
Wm_Callback_Msg: case Msg.lParam of
Wm_LButtonDblClk : Show;
Wm_RButtonDown : ShowPopup;
end;
Wm_EndSession: Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
Wm_QueryEndSession: ;
Wm_Size : ;
Wm_ActivateAPP : ;
end;
end;
Если у Вас в IconList сродержится несколько иконок Вы в любой момент можете выполнить
IconsList.GetIcon(n, Tr_Icon); // Здесь n - номер данной иконки в IconList
TrayIcon.HIcon:=Tr_Icon.Handle;
Shell_NotifyIcon(NIM_MODIFY, @TrayIcon);
и у Вас в трее изменилась иконка !

----------------------------------------------------------

А вот это я воспроизвел:

--------------------------------

unit Unit1;

interface

uses
Windows, ShellAPI, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ImgList;

type
TForm1 = class(TForm)
ImageList1: TImageList;
PopupMenu1: TPopupMenu;
N111111: TMenuItem;
N222221: TMenuItem;
N333331: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Tr_Icon : TIcon;
TrayIcon: TNotifyIconData;
procedure OnMessage(var Msg: TMessage); virtual;

end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
FillChar(TrayIcon, SizeOf(TrayIcon), 0);
Tr_Icon := TIcon.Create; //Создаем иконку
IconList.GetIcon(0, Tr_Icon); //и загружаем ее из ImageList

TrayIcon.cbSize:=SizeOf(TrayIcon);
TrayIcon.Wnd:=AllocateHwnd(OnMessage); // My Proc OnMessage
TrayIcon.HIcon:=Tr_Icon.Handle;
StrPLCopy(TrayIcon.szTip, Application.Title, SizeOf(TrayIcon.szTip)-1);
TrayIcon.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
TrayIcon.uCallbackMessage:=Wm_Callback_Msg;
Shell_NotifyIcon(NIM_ADD, @TrayIcon); // ВСЕ!!! Мы создали иконку в трее

end;
procedure TForm1.OnMessage(var Msg: TMessage);
procedure ShowPopup;
var
x, y : integer;
begin
x := GetSystemMetrics(SM_CXFULLSCREEN);
y := GetSystemMetrics(SM_CYFULLSCREEN) + GetSystemMetrics(SM_CYCAPTION);
PopupMenu1.Popup(x, y)
end;
begin
case Msg.Msg of
procedure TGepardManagerForm.OnMessage(var Msg: TMessage);
begin
case Msg.Msg of
Wm_Callback_Msg: case Msg.lParam of
Wm_LButtonDblClk : Show;
Wm_RButtonDown : ShowPopup;
end;
Wm_EndSession: Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
Wm_QueryEndSession: ;
Wm_Size : ;
Wm_ActivateAPP : ;
end;
end;

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

end.

------------------------

Ну никак не хочет работать. Помогите исправить ошибки.
Очень благодарен.

← →
Pat (2002-02-05 22:45) [1]

Влом разбираться, держи рабочий модуль:
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellApi, StdCtrls, AppEvnts, Menus; type TForm1 = class(TForm) ApplicationEvents1: TApplicationEvents; PopupM: TPopupMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; procedure IconMouse(var Msg : TMessage);message WM_USER + 1; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ApplicationEvents1Minimize(Sender: TObject); procedure N1Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N4Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.IconMouse(var Msg : TMessage); var p:tpoint; begin getcursorpos(p); case Msg.LParam of WM_LBUTTONDBLCLK : begin ShowWindow(Application.Handle,SW_SHOW); Application.Restore; end; WM_rbuttonup: begin SetForegroundWindow(Handle); PopupM.Popup(P.X,P.Y); PostMessage(Handle,WM_NULL,0,0) end; end; end; Procedure ic(a:boolean); var nim:tnotifyicondata; begin with nim do begin cbSize:=sizeof(nim); wnd:=form1.Handle; uid:=1; uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP; hicon:=Application.Icon.Handle; uCallbackMessage:= wm_user+1; szTip:="Твою мать"; end; if a then shell_notifyicon(nim_add,@nim) else shell_notifyicon(nim_delete,@nim); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin action:=canone; application.Minimize; end; procedure TForm1.FormCreate(Sender: TObject); begin ic(true); end; procedure TForm1.FormDestroy(Sender: TObject); begin ic(false); end; procedure TForm1.ApplicationEvents1Minimize(Sender: TObject); begin showwindow(application.handle,0); end; procedure TForm1.N1Click(Sender: TObject); begin application.Terminate; end; procedure TForm1.N3Click(Sender: TObject); begin ShowWindow(Application.Handle,SW_SHOW); Application.Restore; end; procedure TForm1.N4Click(Sender: TObject); begin application.Minimize; end; end.

← →
Севостьянов Игорь (2002-02-07 11:29) [2]

Ребята не страдайте ерундой

Есть же RX Lib посмотри как они это делают

← →
Pat (2002-02-07 17:43) [3]

В своих глюках разбиратсья проще :-)). Тем более тема простая, ИМХО для решения данной задачи не требуются компоненты...

← →
Nikolay (2002-02-07 21:39) [4]

2Севостьянов Игорь ©
Просто тема столько жевалась что можно и самому написать :)

2Lizard
в кладовке пример от Fellomen"ы лежит...
посмотри его

← →
Lizard (2002-02-07 21:44) [5]

Спасибо огромное всем.
Pat, твое письмо я получил, все работает.
Очень благодарен тебе.

Best regards, Lizard.

← →
Cobalt (2002-02-08 19:08) [6]

Сравни твой исходник и мой(исправил _только_ _синтаксические_ ошибки)

unit Unit1;
interface
uses
Windows, ShellAPI, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ImgList;
type
TForm1 = class(TForm)
ImageList1: TImageList;
PopupMenu1: TPopupMenu;
N111111: TMenuItem;
N222221: TMenuItem;
N333331: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Tr_Icon : TIcon;
TrayIcon: TNotifyIconData;
procedure OnMessage(var Msg: TMessage); virtual;
end;
const Wm_Callback_Msg = WM_User+100;

var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
FillChar(TrayIcon, SizeOf(TrayIcon), 0);
Tr_Icon := TIcon.Create; //Создаем иконку
ImageList1.GetIcon(0, Tr_Icon); //и загружаем ее из ImageList
TrayIcon.cbSize:=SizeOf(TrayIcon);
TrayIcon.Wnd:=AllocateHwnd(OnMessage); // My Proc OnMessage
TrayIcon.HIcon:=Tr_Icon.Handle;
StrPLCopy(TrayIcon.szTip, Application.Title, SizeOf(TrayIcon.szTip)-1);
TrayIcon.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
TrayIcon.uCallbackMessage:=Wm_Callback_Msg;
Shell_NotifyIcon(NIM_ADD, @TrayIcon); // ВСЕ!!! Мы создали иконку в трее
end;
procedure TForm1.OnMessage(var Msg: TMessage);
procedure ShowPopup;
var
x, y : integer;
begin
x := GetSystemMetrics(SM_CXFULLSCREEN);
y := GetSystemMetrics(SM_CYFULLSCREEN) + GetSystemMetrics(SM_CYCAPTION);
PopupMenu1.Popup(x, y)
end;
begin
case Msg.Msg of

{procedure TGepardManagerForm.OnMessage(var Msg: TMessage);
begin
case Msg.Msg of}
Wm_Callback_Msg: case Msg.lParam of
Wm_LButtonDblClk : Show;
Wm_RButtonDown : ShowPopup;
end;
Wm_EndSession: Shell_NotifyIcon(NIM_DELETE, @Tr_Icon);
Wm_QueryEndSession: ;
Wm_Size : ;
Wm_ActivateAPP : ;
end;
end;

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

← →
Lizard (2002-02-08 19:36) [7]

Спасибо большое.

← →
Fros (2002-03-18 15:22) [8]

Удалено модератором

Почему не получается ? Вроде все как в форуме описывали... Найти похожие ветки