Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.10.14;
Скачать: CL | DM;

Вниз

иконка в Tray   Найти похожие ветки 

 
Анна   (2007-09-21 12:17) [0]

Здравствуйте, знатоки!
Программа перекачивает с удаленного сервера в БД. При запуске программы - иконка  спускается в Tray. При поднятии формы из Tray, на форме при отсутствии связи отображается информация, что в 12:45:12 связь оборвалась.
Как сделать, чтобы иконка программы в Tray меняла цвет?


 
Johnmen ©   (2007-09-21 12:21) [1]

А как ты её туда запуздырила? В смысле, иконку в трей?


 
Anatoly Podgoretsky ©   (2007-09-21 12:45) [2]

> Анна  (21.09.2007 12:17:00)  [0]

Shell_NotifyIcon и параметром NIM_MODIFY


 
Анна   (2007-09-21 12:45) [3]

Сделала по примеру из книги :

unit shellUnit;

interface

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

const
WM_MYICONNOTIFY = WM_USER + 123;

type
 TForm1 = class(TForm)
   PopupMenu1: TPopupMenu;
   RestoreItem: TMenuItem;
   N1: TMenuItem;
   FileExitItem1: TMenuItem;
   HideItem: TMenuItem;
   Button1: TButton;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure RestoreItemClick(Sender: TObject);
   procedure HideItemClick(Sender: TObject);
   procedure FileExitItem1Click(Sender: TObject);
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
   ShownOnce: Boolean;
 public
   { Public declarations }
   procedure WMICON(var msg: TMessage); message WM_MYICONNOTIFY;
   procedure WMSYSCOMMAND(var msg: TMessage);message WM_SYSCOMMAND;
   procedure RestoreMainForm;
   procedure HideMainForm;
   procedure CreateTrayIcon(n:Integer);
   procedure DeleteTrayIcon(n:Integer);
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}
uses ComObj,  activex, ShellApi, shlobj, registry;

procedure TForm1.WMICON(var msg: TMessage);
var P : TPoint;
begin
case msg.LParam of
WM_LBUTTONDOWN:
 begin
  GetCursorPos(p);
  SetForegroundWindow(Application.MainForm.Handle);
  PopupMenu1.Popup(P.X, P.Y);
 end;
WM_LBUTTONDBLCLK : RestoreItemClick(Self);
end;
end;

procedure TForm1.WMSYSCOMMAND(var msg: TMessage);
begin
inherited;
if (Msg.wParam=SC_MINIMIZE) then HideItemClick(Self);
end;

procedure TForm1.HideMainForm;
begin
 Application.ShowMainForm := False;
 ShowWindow(Application.Handle, SW_HIDE);
 ShowWindow(Application.MainForm.Handle, SW_HIDE);
end;

procedure TForm1.RestoreMainForm;
var i,j : Integer;
begin
 Application.ShowMainForm := True;
 ShowWindow(Application.Handle, SW_RESTORE);
 ShowWindow(Application.MainForm.Handle, SW_RESTORE);
 if not ShownOnce then
 begin
   for I := 0 to Application.MainForm.ComponentCount -1 do
     if Application.MainForm.Components[I] is TWinControl then
       with Application.MainForm.Components[I] as TWinControl do
         if Visible then
         begin
           ShowWindow(Handle, SW_SHOWDEFAULT);
           for J := 0 to ComponentCount -1 do
             if Components[J] is TWinControl then
               ShowWindow((Components[J] as TWinControl).Handle, SW_SHOWDEFAULT);
         end;
   ShownOnce := True;
 end;

end;

procedure TForm1.CreateTrayIcon(n:Integer);
var nidata : TNotifyIconData;
begin
with nidata do
 begin
  cbSize := SizeOf(TNotifyIconData);
  Wnd := Self.Handle;
  uID := 1;
  uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  uCallBackMessage := WM_MYICONNOTIFY;
  hIcon := Application.Icon.Handle;
  StrPCopy(szTip,Application.Title);
 end;
 Shell_NotifyIcon(NIM_ADD, @nidata);
end;

procedure TForm1.DeleteTrayIcon(n:Integer);
var nidata : TNotifyIconData;
begin
with nidata do
 begin
  cbSize := SizeOf(TNotifyIconData);
  Wnd := Self.Handle;
  uID := 1;
 end;
 Shell_NotifyIcon(NIM_DELETE, @nidata);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// ShownOnce:= False;
// CreateTrayIcon(1);
// HideItem.Enabled := False;
//showmessage("Çàøëè â êðèàòå");
end;

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

procedure TForm1.RestoreItemClick(Sender: TObject);
begin
RestoreMainForm;
DeleteTrayIcon(1);
RestoreItem.Enabled := False;
HideItem.Enabled := True;
end;

procedure TForm1.HideItemClick(Sender: TObject);
begin
HideMainForm;
CreateTrayIcon(1);
HideItem.Enabled := False;
RestoreItem.Enabled := True;
end;

procedure TForm1.FileExitItem1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShownOnce:= False;
form1.Visible:= False;
CreateTrayIcon(1);
HideItem.Enabled := False;

end;

end.


 
Anatoly Podgoretsky ©   (2007-09-21 13:05) [4]

> Анна  (21.09.2007 12:45:03)  [3]

Вот по образцу и подобию, тольк с NIM_MODIFY, когда надо сменить икнку


 
Анна   (2007-09-21 13:25) [5]


> Вот по образцу и подобию, тольк с NIM_MODIFY, когда надо
> сменить икнку

Нет, не могу сообразить  с каким параметром?
Shell_NotifyIcon(NIM_MODIFY, ?[@nidata]);
Надо ли создавать новую иконку .ico  с другими цветами, записывать их на жесткий диск и оттуда считывать?


 
stanislav ©   (2007-09-21 13:27) [6]

? = icon.handle , новой иконки
сохранить в ресурс можно.


 
Anatoly Podgoretsky ©   (2007-09-21 13:31) [7]

 hIcon := Application.Icon.Handle;
 StrPCopy(szTip,Application.Title);
end;
Shell_NotifyIcon(NIM_ADD, @nidata);

Сменить это (жирным -  загрузить другую, нужную) и при необходимости Application.Title на нужный.


 
Анна   (2007-09-21 14:46) [8]


> Anatoly Podgoretsky ©   (21.09.07 13:31) [7]

Сделала так:
Application.Icon.LoadFromFile("hippo.ico");
hIcon := Application.Icon.Handle;
Shell_NotifyIcon(NIM_ADD, @nidata);
Работает. Только не знаю грамотно ли? (Application.Icon.LoadFromFile("hippo.ico");)
Спасибо за ответы!


 
Anatoly Podgoretsky ©   (2007-09-21 14:50) [9]

> Анна  (21.09.2007 14:46:08)  [8]

Мне тоже это не нравится, побочный эффект - меняется иконка у приложения, если это нормально то можно не беспокоиться.
Но иконки лучше держать в ресурсах, а не файлах.


 
Плохиш ©   (2007-09-21 14:50) [10]

Используй TImageList и загружай иконки из него.


 
Анна   (2007-09-21 15:09) [11]


> Плохиш ©   (21.09.07 14:50) [10]

Сделала:
hIcon:= Image1.Picture.Icon.Handle;
Получилось посимпатичнее.
Спасибо большое всем.



Страницы: 1 вся ветка

Текущий архив: 2007.10.14;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.028 c
15-1189477252
Slider007
2007-09-11 06:20
2007.10.14
С днем рождения ! 11 сентября 2007 вторник


3-1181295469
DelphiLexx
2007-06-08 13:37
2007.10.14
XML - сохранение данных из БД


15-1189951044
Tirael
2007-09-16 17:57
2007.10.14
как можно перехватить звук в системе?


4-1176206198
Ega23
2007-04-10 15:56
2007.10.14
Как воспроизвести видеозапись в конкретном окне?


10-1138094689
Bratskiy
2006-01-24 12:24
2007.10.14
Поиск в Word по определённому стилю