Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Иконка в системном трее, статья 
:(
    Опции темы
Poseidon
Дата 11.6.2005, 02:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133



Я заметил, что вопросы о иконки в трее возникают довольно часто, поэтому решил выложить на форум эту статью

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


Наверняка многие, кто начинает программировать на Delphi нередко задавались такими вопросами как:
1. А как можно поместить иконки приложения в системный трей Windows возле часов?
2. Как скрыть главную форму приложения при запуске и показывать ее по команде всплывающего меню иконки приложения в системной трее, и как затем скрыть ее обратно?


Знакомо да? Что ж, сам я тоже когда-то был начинающим программистом, и потратил уйму времени и нервов за изучение и поиска решений для всех вышеизложенных вопросов. И именно сейчас я готов изложить Вам все свои знания по части работы с иконкой приложения в системной трее.

Статью я решил разделить на две части. Что содержит каждая из них догадаться не трудно - вопросов, о решении которых я расскажу тоже две.

Итак, это часть 1: "Добавление иконки в системный трей".
В этой части мы научимся:
- добавлять, изменять и удалять иконку.
- отлавливать события мыши на иконке (наведение, клик, двойной клик и т.д.)
- менять иконку во время работы приложения, а также текст всплывающей подсказки.

Начать статью я решил не с описания всевозможных компонентов для данной сферы программинга (которых полным полно в интернете), а с описания азов - WinAPI функций, предназначенных для работы с system tray. Хотя, "функции", как то больно громко получилось. На самом деле она всего одна:

Код
function Shell_NotifyIcon ( dwMessage: Cardinal; lpData: PNotifyIconData ) : LongBool;

(я привожу Вам упрощенное представление функции сделанное лично мной, т.к. если взять описание функции из WinAPI SDK - понять его будет намного труднее)

подробнее о параметрах:
dwMessage:
Параметр, а точнее команда, которая указывает этой функции что именно она должна делать. Может принимать следующие значения констант:
NIM_ADD - добавляет иконку в трей
NIM_DELETE - удаляет иконку из системного трея
NIM_MODIFY - меняет (обновляет) иконку в системном трее.

lpData:
Сей параметр есть запись, которая содержит всю информацию об добавляемой, удаляемой или изменяемой иконке. Данная запись имеет вид:

_NOTIFYICONDATAA = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..63] of AnsiChar;
end;
(указатель PNotifyIconData является указателем именно на эту запись)


Давайте рассмотрим, какие именно данные содержит данная запись:

cbSize: Размер данной записи;
Wnd: Handle того окна, которое будет получать сообщения от иконки;
uID: Идентификатор иконки;
uFlags: Здесь содержатся константы, означающие, какие данные верны в записи:
NIF_ICON - hIcon содержит верную информацию.
NIF_MESSAGE - uCallbackMessage содержит верную информацию.
NIF_TIP -szTip содержит верную информацию.
(Подробнее об этом я расскажу ниже)
uCallbackMessage: Назначенный Вами идентификатор сообщения, которое будет получать приложение от иконки.
hIcon: Собственно Handle иконки (TIcon.Handle).
szTip: Текст всплывающей подсказки (не более 64 символов).



Мда, наверняка ничего не понятно, да? ..особенно новичкам. Ничего! Далее я приведу код небольшой программы, написанной лично мной. Весь код программы имеет очень богатые комментарии. С их помощью понять смысл каждого шага Вам будет нетрудноsmile
Ниже привожу листинг файла main.pas (файл основной и единственной формы приложения):
Внимание!: в тексте программы прошу не путать два понятия: "иконка" - это то, что собственно находится в системно трее, и "иконка (изображение)" - это то, что содержит то само изображение иконочки.

Код
unit main;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    TI_Event: TLabel;
    GroupBox2: TGroupBox;
    TI_DC: TLabel;
    GroupBox3: TGroupBox;
    Icon: TImage;
    IconFile: TEdit;
    Browse: TButton;
    Exit: TButton;
    About: TButton;
    OpenDialog1: TOpenDialog;
    GroupBox4: TGroupBox;
    ToolTip: TEdit;
    SetToolTip: TButton;
    AboutGroupBox: TGroupBox;
    Desk: TLabel;
    Author: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    email: TLabel;
    www: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BrowseClick(Sender: TObject);
    procedure ExitClick(Sender: TObject);
    procedure SetToolTipClick(Sender: TObject);
    procedure wwwClick(Sender: TObject);
    procedure emailClick(Sender: TObject);
    procedure AboutClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   procedure IconCallBackMessage( var Mess : TMessage ); message WM_USER + 100;
   //Здесь мы объявлем процедуру, которая будет выполнятся каждый раз, когда
   //на иконке будет происходит какое-либо событие (клик мышки и т.п.)
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var nid : TNotifyIconData;
begin
  //Добавляем иконку в трей при старте программы:
  with nid do  //Указываем параметры иконки, для чего используем структуру
               //TNotifyIconData.
  begin
    cbSize := SizeOf( TNotifyIconData ); //Размер все структуры
    Wnd := Form1.Handle; //Здесь мы указывает Handle нашей главной формы
                         //которая будет получать сообщения от иконки.
    uID := 1;            //Идентификатор иконки
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; //Обозначаем то, что в
                                                  //параметры входят:
                                                  //Иконка, сообщение и текст
                                                  //подсказки (хинта).
    uCallbackMessage := WM_USER + 100;            //Здесь мы указываем, какое
                                                  //сообщение должна  высылать
                                                  //иконочка нашей главной форме,
                                                  //в тот момент, когда на ней
                                                  //(иконке)  происходят
                                                  //какие-либо события
    hIcon := Application.Icon.Handle;             //Указываем на Handle
                                                  //иконки (изображения)
                                                  //(в данной случае берем
                                                  //иконку основной формы
                                                  //приложения. Ниже Вы увидите
                                                  //как можно ее изменить)
    StrPCopy(szTip, ToolTip.Text);                //Указываем текст всплывающей
                                                  //посдказки, который берем из
                                                  //компонента ToolTip,
                                                  //расположенного на главной
                                                  //форме.
  end;
  Shell_NotifyIcon( NIM_ADD, @nid );
  //Собственно добавляем иконку в трей:)
  //Обратите внимание, что здесь мы исползуем константу
  //NIM_ADD (добавление иконки).
  IconFile.Text:=Application.ExeName;
  //Выводим на главной форме пусть к файлу, который содержит
  //иконку (изображение):)
  Icon.Picture.Icon:=Application.Icon;
  //Теперь выводим на главной форме изображение
  //иконки (изображения) в увеличенном виде
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var nid : TNotifyIconData;
begin
  with nid do
  begin
    cbSize := SizeOf( TNotifyIconData );
    Wnd := Form1.Handle;
    uID := 1;
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    uCallbackMessage := WM_USER + 100;
    hIcon := Application.Icon.Handle;
    StrPCopy(szTip, ToolTip.Text);
  end;
  Shell_NotifyIcon( NIM_DELETE, @nid );
  //Удаляем иконку из трея. Параметры мы вводим для того,
  //чтобы функция точно знала, какую именно иконку надо удалять.
  //Обратите внимание, что здесь мы исползуем константу
  //NIM_DELETE (удаление иконки).
end;

procedure TForm1.IconCallBackMessage( var Mess : TMessage );
var Mouse: TMouse;
begin
  case Mess.lParam of
    //Здесь Вы можете обрабатывать все события, происходящие на иконке:)
    //На главнй форме я специально расположил две метки, в которых,
    //при возникновении какого-либо события будет писаться что именно произошло:)
    //Но, теперь во второй части во время некоторых событий будут происходит
    //реальные процессы.
    WM_LBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок левой кнопкой'       ;
    WM_LBUTTONDOWN    : TI_Event.Caption:= 'Нажатие левой кнопки мыши'          ;
    WM_LBUTTONUP      : TI_Event.Caption:= 'Отжатие левой кнопки мыши'          ;
    WM_MBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок средней кнопкой мыши';
    WM_MBUTTONDOWN    : TI_Event.Caption:= 'Нажатие средней кнопки мыши'        ;
    WM_MBUTTONUP      : TI_Event.Caption:= 'Отжатие средней кнопки мыши'        ;
    WM_MOUSEMOVE      : TI_Event.Caption:= 'Перемещение мыши'                   ;
    WM_MOUSEWHEEL     : TI_Event.Caption:= 'Вращение колесика мыши'             ;
    WM_RBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок правой кнопкой'      ;
    WM_RBUTTONDOWN    : TI_Event.Caption:= 'Нажатие правой кнопки мыши'         ;
    WM_RBUTTONUP      : TI_Event.Caption:= 'Отжатие правой кнопки мыши'         ;
  end;
end;

procedure TForm1.BrowseClick(Sender: TObject);
var I   : TIcon;
    nid : TNotifyIconData;
begin
  //Здесь мы меням иконку приложения, для чего используем диалоговое окно
  //(для выбора файла, который содержит изображение иконки)
  //Итак, все потизоньку:
  if OpenDialog1.Execute then //Запуск диаголового окна
  begin
    I:=TIcon.Create; //Создаем объект I типа TIcon
    I.LoadFromFile(OpenDialog1.Filename); //Теперь загружаем в него изображение
                                          //из того файла, который был выбран в
                                          //окне диалогового окна
    //Далее делаем все тоже самое, что и раньше, создаем структуру типа
    //TNotifyIconData куда заносим все параметры иконки:)
    with nid do
    begin
      cbSize := SizeOf( TNotifyIconData );
      Wnd := Form1.Handle;
      uID := 1;
      uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
      uCallbackMessage := WM_USER + 100;
      hIcon := I.Handle;
      StrPCopy(szTip, ToolTip.Text);
    end;
    Shell_NotifyIcon( NIM_MODIFY , @nid );
    //А вот здесь мы заносим изменения в иконку, которая находится в системном
    //трее обратите внимание, что здесь мы исползуем константу NIM_MODIFY
    //(изменение иконки).
    Icon.Picture.Icon:=I;
    IconFile.Text:=OpenDialog1.FileName;
    I.Free;
  end;
end;

procedure TForm1.ExitClick(Sender: TObject);
begin
  //Закрываем приложение. 
  Close;
end;

procedure TForm1.SetToolTipClick(Sender: TObject);
var nid : TNotifyIconData;
begin
  //Здесь мы назначаем всплывающую посказу:)
  //Здесь все тоже самое, что и в предыдущей процедуре.
  //Только иконка (изображение) берется из компонента Icon,
  //который назодится на главной форме:)
  //А текст всплывающей посказки берем из
  //компонента ToolTip (который расположен на главной форме)
  with nid do
  begin
      cbSize := SizeOf( TNotifyIconData );
      Wnd := Form1.Handle;
      uID := 1;
      uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
      uCallbackMessage := WM_USER + 100;
      hIcon := Icon.Picture.Icon.Handle;
      StrPCopy(szTip, ToolTip.Text);
  end;
  Shell_NotifyIcon( NIM_MODIFY , @nid );
  //.. и снова меням иконку:)
end;

//Далее идут процедуры, относящие работе сведений о программе
//Тут нет ничего сложного :-)
procedure TForm1.wwwClick(Sender: TObject);
begin
  ShellExecute(Application.Handle,'open','http://delphi.hostmos.ru',nil,nil,0);
end;

procedure TForm1.emailClick(Sender: TObject);
begin
  ShellExecute(Application.Handle,'open','mailto:[email protected]',nil,nil,0);
end;

procedure TForm1.AboutClick(Sender: TObject);
begin
  if Form1.Width=250 then
  begin
    Form1.Width:=430;
    About.Caption:='О Программе <<';
  end
  else begin
    Form1.Width:=250;
    About.Caption:='О Программе >>';
  end;
  AboutGroupBox.Visible:=not AboutGroupBox.Visible;
end;

end.



Итак, это вторая часть моей небольшой "эпопеи", посвященное иконке в системной трее.

В этой части мы рассмотрим и научимся решать следующие вопросы:
1. Как добавить всплывающее меню к иконке?
2. Как скрывать главную форму приложения при запуске, и показываеть его по команде всплывающего меню.


Для изучения данных вопросов, мы воспользуемся все тем же примером, который использовали в первой части, и немного модернизируем его.
Откройте в Delphi исходник от первой части статьи и внесите в него следующие изменения:
1. Найдите на форме кнопку с именем "Exit". Теперь, измените ее свойство "Caption" на "Скрыть", а свойство "Name" на "BHide";
2. Добавьте на форму компонент PupopMenu и измените его свойство "Name" на "PopupMenu".
3. Теперь два раза щелкните на нем, чтобы открылся редактор меню, и создайте точно такое меню:
Пункту "О программе" дайте имя "PAbout", пункту "Настройки" дайте имя "PSettings", пункту "Выход" имя "PExit". У пункта "Настройки" свойство "Default" установите в "True" (этим мы делаем данный пункт меню основным, т.е. данное действие будет выполняться при двойном нажатии левой кнопки мыши на иконке приложения в системном трее. Как это сделать Вы узнаете чуть ниже). После чего закройте редактор меню.


Теперь, давайте приступим к решению вопросов, заданных в начале статьи.

Начнем мы с того, что научимся скрывать главную форму при запуске приложения. Для этого вам необходимо зайти в пункт меню самой Delphi: Project -> View Source (Проект -> Просм. источник). После чего Вашим глазам откроется содержание файла tray.dpr. Текста там немного, так что ничего страшного в этом файле нет smile Теперь, найдите там строчку
Код
Application.CreateForm(TForm1, Form1);

которая создает главную форму приложения, и, сразу после нее, на следующей строке напишите:
Код
Application.ShowMainForm:=False;

Вот и все! Этой строкой вы запретили показ главной формы приложения при запуске. Чтобы проверить, сохраните все изменения, и запустите программу. Теперь, при запуске, Вы увидите только иконку в системном трее. Да, кстати, закрыть программу теперь возможно только в Delphi при помощи меню Run -> Program Reset, или при помощи горячих клавиш Ctrl-F2. Но это только временно, ниже мы решим эту проблему.

Далее, давайте напишем нужные коды в обработчиках событий нажатия кнопки мыши в каждом из пунктов меню:

Пункт "О программе":
Код

procedure TForm1.PAboutClick(Sender: TObject);
begin
  //Показываем главную форму в раскрытой областью "О программе"
  AboutClick(Form1); //Выполняем процедуру нажатия на кнопку "О программе"
  Form1.Show;        //И, именно вот такой строчкой, мы показываем
                     //главную форму приложения.
  Form1.Activate;    //..и активируем ее :)
end; 


Пункт "Настройки":
Код

procedure TForm1.PSettingsClick(Sender: TObject);
begin
  //Описание сморите выше:)
  Form1.Show;
  Form1.Activate;
end; 


Пункт "Выход":
Код

procedure TForm1.PExitClick(Sender: TObject);
begin
  Close; //обыкновенный выход из программы.
end; 


По моему комментарии излишнеsmile Надеюсь Вам понятно, что будет происходить во время этих событий.

А сейчас мы сделаем самое главное и самое интересное: заставим наше меню "всплывать" на иконке во время нажатия правой кнопки мыши, а нашу главную форму "показываться" при двойной нажатии левой кнопки мыши.

В исходном коде программы найдите процедуру IconCallBackMessage и модернизируйте ее так, чтобы она выглядела так, как показано ниже:

Код

procedure TForm1.IconCallBackMessage( var Mess : TMessage );
var Mouse: TMouse;
begin
  case Mess.lParam of
    //Здесь Вы можете обрабатывать все события, происходящие на иконке:)
    //На главной форме я специально расположил две метки, в которых,
    //при возникновении какого-либо события будет писаться что именно произошло:)
    //Но, теперь во второй части во время некоторых событий будут происходит
    //реальные процессы.
    WM_LBUTTONDBLCLK  :  //Обрабатываем двойной щелчок левой кнопки мыши.
    begin
      PSettingsClick(Form1); //Выполняем пункт меню "Настройки".
    end;
    WM_LBUTTONDOWN    : TI_Event.Caption:= 'Нажатие левой кнопки мыши'          ;
    WM_LBUTTONUP      : TI_Event.Caption:= 'Отжатие левой кнопки мыши'          ;
    WM_MBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок средней кнопкой мыши';
    WM_MBUTTONDOWN    : TI_Event.Caption:= 'Нажатие средней кнопки мыши'        ;
    WM_MBUTTONUP      : TI_Event.Caption:= 'Отжатие средней кнопки мыши'        ;
    WM_MOUSEMOVE      : TI_Event.Caption:= 'Перемещение мыши'                   ;
    WM_MOUSEWHEEL     : TI_Event.Caption:= 'Вращение колесика мыши'             ;
    WM_RBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок правой кнопкой'      ;
    WM_RBUTTONDOWN    : TI_Event.Caption:= 'Нажатие правой кнопки мыши'         ;
    WM_RBUTTONUP      : //Обрабатываем нажатие правой кнопкой мыши.
    begin
      PopupMenu.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);
      //заставляем "всплыть" наше меню:)
    end;
  end;
end;


С первым событием двойного нажатия левой кнопки мыши наверняка все понятно - мы выполняем вызываем обработчик события нажатия кнопки мыши на пункте меню "Настройки".
Но, с нажатием правой кнопки мыши наверное потруднее да? Чтож, все по порядку:
В самом начале процедуры мы объявляем объект Mouse типа TMouse. Для того, чтобы позднее при помощи него узнать координаты мыши на экране.
Далее мы пишем следующую строчку:
Код
PopupMenu.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);

Смысл ее простой. Метод Popup используется для показа меню в заданной точке экрана. Именно здесь нам пригодился объект Mouse, при помощи свойств которого, мы узнаем координаты мыши на экране, во время нажатия правой кнопки мыши.
Но, в "всплывании" меню есть еще одни нюанс. Если сейчас все оставить все как есть, оно будет "зависать" при потери фокуса - т.е. просто не будет исчезать. Для устранения данного бага в обработчике события OnPopup нашего меню впишите нижеследующее:
Код
SetForegroundWindow(Form1.Handle);

Этим мы указываем, что активным является главная форма нашего приложения (даже если он невидима). И, при переключении между приложения оно теряет свою активность, и, соответственно, всплывающее меню исчезает из виду, т.к. оно является дочерним объектом, по отношению к форме.

Вот и в принципе и всеsmile ...ах, да.. совсем забыл. В самом начале мы изменили надпись на бывшей кнопке закрытия приложения на "Скрыть", т.е. теперь при ее нажатии необходимо, чтобы главная форма приложения "пряталась". Чтож, делается это просто, в обработчик события нажатия данной кнопки впишите одну единственную строку:
Код
Form1.Hide; 

А вот теперь все! Надеюсь, по мере чтения статей этой серии Вам становится все легче и легче понять азы работы с иконкой приложения в системной трееsmile


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
SoWa
Дата 11.6.2005, 03:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Харекришна
****


Профиль
Группа: Комодератор
Сообщений: 2422
Регистрация: 18.10.2004

Репутация: 2
Всего: 74



Молодец! Это конечно не компонент, который я всегда юзаю, но написано понятно! Твой [+]


--------------------
Всем добра smile
PM MAIL ICQ   Вверх
Poseidon
Дата 11.6.2005, 11:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133



Цитата(SoWa @ 11.6.2005, 03:48)
Это конечно не компонент, который я всегда юзаю
Для начинающих праграммеров (а по сути это именно для них) установить компонент становится проблемой (может об этом статью написать? smile ), поэтому им легче использовать WinApi.



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Palladin
Дата 28.2.2006, 18:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17



Спасибо огромное тебе за эту статью, еслиб у меня было уже 100 сообщений, я б тебе [+] полюбому бы повесил, молодец!!!!!!!!! smile
Добавлено @ 18:58
Короче вот моя прога(весь код) мне ненадо чтобы когда на трей наводиш всплывали подсказки и прочее, мне надо только чтоб когда прога запускалась она не сворачивалась при загрузке проги, а делала это при нажатии на кнопку Button5, а когда прога уже в трее и её надо снова развернуть, то поней надо просто клинуть было чтобы она снова разворачивалась в нормальное состояние и всё, больше ничего, плиззз поправьте что там не так, а то я уже пол дня убил чё-то не выходит(опыт нулёвый две недели делфи учу) smile

Код


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShellApi, Menus, ExtCtrls, StdCtrls, Masks, TLHelp32, ComCtrls, MMSystem;

type
TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    ListBox1: TListBox;
    Button3: TButton;
    Button4: TButton;
    IconFile: TEdit;
    Button5: TButton;
procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
//Объявляем функции для работы
//-------------------------------------------------------
//Функция ExistProcess c параметром AName = имя процесса
//возвращает true, если процесс запущен, либо
//false в противном случае
//-------------------------------------------------------
function ExistProcess(AName : PChar ) : boolean; StdCall;
//-------------------------------------------------------
//Процедура FindFiles имеет следующие параметры:
//Folder = Папка, в которой производить поиск (Можно ставить корень 'C:\')
//Mask = Маска, по которой ищется файл. Напр. (*.exe - В папке будут искаться
//все exe-файлы)
//SubFolders = параметр указывает, производить ли поиск в подпапках
//(по умолчанию - производить.)
//-------------------------------------------------------
procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);

implementation

uses Unit3, Unit4;

{$R *.dfm}

var
WoWScanerForTraffic : PChar; //Полное имя твоей проги

function ExistProcess(AName : PChar ) : boolean; StdCall;
var
lSnapHandle, lProcHandle: THandle;
ProcStruct : PROCESSENTRY32;
lProcessPath : Pchar;
PID : Cardinal;
begin
Result := false;
lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
if lSnapHandle = 0 then
exit;
ProcStruct.dwSize := sizeof( PROCESSENTRY32 );
if Process32First(lSnapHandle, ProcStruct) then
begin
try
repeat
lProcessPath := ProcStruct.szExeFile;
if uppercase(lProcessPath) = uppercase(AName) then
begin
PID := ProcStruct.th32ProcessID;
Result := true;
Break;
end;
until not Process32Next(lSnapHandle, ProcStruct);
finally
CloseHandle(lSnapHandle);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var nid : TNotifyIconData;
begin
//Добавляем иконку в трей при старте программы:
with nid do //Указываем параметры иконки, для чего используем структуру
//TNotifyIconData.
begin
cbSize := SizeOf( TNotifyIconData ); //Размер все структуры
Wnd := Form1.Handle; //Здесь мы указывает Handle нашей главной формы
//которая будет получать сообщения от иконки.
uID := 1; //Идентификатор иконки
uFlags := NIF_ICON; //Обозначаем то, что в
//параметры входят:
hIcon := Application.Icon.Handle; //Указываем на Handle
//иконки (изображения)
//(в данной случае берем
//иконку основной формы
//приложения. Ниже Вы увидите
//как можно ее изменить)
end;
Shell_NotifyIcon( NIM_ADD, @nid );
//Собственно добавляем иконку в трей:)
//Обратите внимание, что здесь мы исползуем константу
//NIM_ADD (добавление иконки).
IconFile.Text:=Application.ExeName;
//Выводим на главной форме пусть к файлу, который содержит
//иконку (изображение):)
Icon.Picture.Icon:=Application.Icon;
//Теперь выводим на главной форме изображение
//иконки (изображения) в увеличенном виде
end;


procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);
var
SearchRec : TSearchRec;
Result : Integer;
begin
Folder := IncludeTrailingBackSlash(Folder);
Result := FindFirst(Folder + '*.*', faAnyFile, SearchRec);
try
while Result = 0 do
with SearchRec do begin
if (Attr and faDirectory) <> 0 then begin
if SubFolders and (Name <> '.') and (Name <> '..') then
FindFiles(Folder + Name, Mask, SubFolders);
end { if Attr } else begin
if MatchesMask(Name, Mask) then begin
WoWScanerForTraffic := PChar(Folder + Name);
end; { if }
end; { else }
Result := FindNext(SearchRec);
end; { with }
finally { try }
FindClose(SearchRec);
end; { finally }
FindClose(SearchRec);
end;



procedure SendMCICommand(Cmd: string);  // процедура звука
var
RetVal: Integer;
ErrMsg: array[0..254] of char;
begin
RetVal := mciSendString(PChar(Cmd), nil, 0, 0);
if RetVal <> 0 then
begin
{get message for returned value}
mciGetErrorString(RetVal, ErrMsg, 255);
MessageDlg(StrPas(ErrMsg), mtError, [mbOK], 0);
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if ExistProcess('wowemu.exe') then
listbox1.Items.add('[' + TimeToStr(Time) + '] : Сервер работает')
else begin
FindFiles(edit1.text,'wowemu.exe');
listbox1.Items.add('[' + TimeToStr(Time) + '] : Сервер полетел, запускаю');
if WoWScanerForTraffic <> '' then
WinExec(WoWScanerForTraffic, SW_SHOW);
end; 
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled := false;
end;

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


procedure TForm1.N2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
form4.show;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
listbox1.Clear;
end;

end.




плиззз помогите smile smile

Это сообщение отредактировал(а) RooR - 28.2.2006, 19:01


--------------------
Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]
PM MAIL   Вверх
Romikgy
Дата 28.2.2006, 19:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 13
Всего: 146



Код

procedure TForm1.FormCreate(Sender: TObject);
var nid : TNotifyIconData;
begin
  //Добавляем иконку в трей при старте программы:
  with nid do  //Указываем параметры иконки, для чего используем структуру
               //TNotifyIconData.
  begin
    cbSize := SizeOf( TNotifyIconData ); //Размер все структуры
    Wnd := Form1.Handle; //Здесь мы указывает Handle нашей главной формы
                         //которая будет получать сообщения от иконки.
    uID := 1;            //Идентификатор иконки
    uFlags := NIF_ICON or NIF_MESSAGE ; //Обозначаем то, что в
                                                  //параметры входят:
                                                  //Иконка, сообщение и текст
                                                  //подсказки (хинта).
    uCallbackMessage := WM_USER + 100;            //Здесь мы указываем, какое
                                                  //сообщение должна  высылать
                                                  //иконочка нашей главной форме,
                                                  //в тот момент, когда на ней
                                                  //(иконке)  происходят
                                                  //какие-либо события
    hIcon := Application.Icon.Handle;             //Указываем на Handle
                                                  //иконки (изображения)
                                                  //(в данной случае берем
                                                  //иконку основной формы
                                                  //приложения. Ниже Вы увидите
                                                  //как можно ее изменить)
    //StrPCopy(szTip, ToolTip.Text);                //Указываем текст всплывающей
                                                  //посдказки, который берем из
                                                  //компонента ToolTip,
                                                  //расположенного на главной
                                                  //форме.
  end;
  Shell_NotifyIcon( NIM_ADD, @nid );
  //Собственно добавляем иконку в трей:)
  //Обратите внимание, что здесь мы исползуем константу
  //NIM_ADD (добавление иконки).
  IconFile.Text:=Application.ExeName;
  //Выводим на главной форме пусть к файлу, который содержит
  //иконку (изображение):)
  Icon.Picture.Icon:=Application.Icon;
  //Теперь выводим на главной форме изображение
  //иконки (изображения) в увеличенном виде
end;

procedure TForm1.IconCallBackMessage( var Mess : TMessage );
var Mouse: TMouse;
begin
  case Mess.lParam of
    //Здесь Вы можете обрабатывать все события, происходящие на иконке:)
    //На главнй форме я специально расположил две метки, в которых,
    //при возникновении какого-либо события будет писаться что именно произошло:)
    //Но, теперь во второй части во время некоторых событий будут происходит
    //реальные процессы.
    //WM_LBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок левой кнопкой'       ;
    //WM_LBUTTONDOWN    : TI_Event.Caption:= 'Нажатие левой кнопки мыши'          ;
    WM_LBUTTONUP      : begin Form1.Visible:=true; Application.Restore;      end;
    
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
Form1.Visible:=false;
end;



--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile

PM   Вверх
Palladin
Дата 1.3.2006, 00:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17



спасибо, но что-то не так, вот такие ошибки

[Error] Unit1.pas(140): Undeclared identifier: 'IconFile'
[Error] Unit1.pas(143): Undeclared identifier: 'Picture'
[Error] Unit1.pas(148): Undeclared identifier: 'IconCallBackMessage'
[Error] Unit1.pas(148): ';' expected but '(' found
[Error] Unit1.pas(148): ';' expected but ')' found

smile smile smile smile smile smile smile smile smile

6 час пошёл как я пытаюсь что-то исправить, хелп ме smile

Это сообщение отредактировал(а) RooR - 1.3.2006, 01:25


--------------------
Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]
PM MAIL   Вверх
Palladin
Дата 1.3.2006, 01:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17



Ура, я разобрался, всё пашет, сорри за офтоп smile


--------------------
Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]
PM MAIL   Вверх
Демо
Дата 1.3.2006, 15:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50



Сейчас исчело такое понятие, как "System tray", к сожалению. Microsoft зачем-то избавилась от него. Теперь это "Область сообщений/уведомлений"



--------------------
    
PM MAIL ICQ Skype   Вверх
Palladin
Дата 1.3.2006, 18:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17



Мда, я к сожалению не совсм разобрался, прога сворачивается но значка внизу никакого нетsmile((((( что-то не то.......
поправьте плиззз
Код

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShellApi, Menus, ExtCtrls, StdCtrls, Masks, TLHelp32, ComCtrls, MMSystem;

type
TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Icon: TImage;
IconFile: TEdit;
    ToolTip: TEdit;
    Browse: TButton;
    OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure BrowseClick(Sender: TObject);
private
{ Private declarations }
public
procedure IconCallBackMessage( var Mess : TMessage ); message WM_USER + 100;
{ Public declarations }
end;

var
Form1: TForm1;
//Объявляем функции для работы
//-------------------------------------------------------
//Функция ExistProcess c параметром AName = имя процесса
//возвращает true, если процесс запущен, либо
//false в противном случае
//-------------------------------------------------------
function ExistProcess(AName : PChar ) : boolean; StdCall;
//-------------------------------------------------------
//Процедура FindFiles имеет следующие параметры:
//Folder = Папка, в которой производить поиск (Можно ставить корень 'C:\')
//Mask = Маска, по которой ищется файл. Напр. (*.exe - В папке будут искаться
//все exe-файлы)
//SubFolders = параметр указывает, производить ли поиск в подпапках
//(по умолчанию - производить.)
//-------------------------------------------------------
procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);
implementation

uses Unit3, Unit4;

{$R *.dfm}

var
WoWScanerForTraffic : PChar; //Полное имя твоей проги

function ExistProcess(AName : PChar ) : boolean; StdCall;
var
lSnapHandle, lProcHandle: THandle;
ProcStruct : PROCESSENTRY32;
lProcessPath : Pchar;
PID : Cardinal;
begin
Result := false;
lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
if lSnapHandle = 0 then
exit;
ProcStruct.dwSize := sizeof( PROCESSENTRY32 );
if Process32First(lSnapHandle, ProcStruct) then
begin
try
repeat
lProcessPath := ProcStruct.szExeFile;
if uppercase(lProcessPath) = uppercase(AName) then
begin
PID := ProcStruct.th32ProcessID;
Result := true;
Break;
end;
until not Process32Next(lSnapHandle, ProcStruct);
finally
CloseHandle(lSnapHandle);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var nid : TNotifyIconData;
begin
//Добавляем иконку в трей при старте программы:
with nid do //Указываем параметры иконки, для чего используем структуру
//TNotifyIconData.
begin
cbSize := SizeOf( TNotifyIconData ); //Размер все структуры
Wnd := Form1.Handle; //Здесь мы указывает Handle нашей главной формы
//которая будет получать сообщения от иконки.
uID := 1; //Идентификатор иконки
uFlags := NIF_ICON or NIF_MESSAGE ; //Обозначаем то, что в
//параметры входят:
//Иконка, сообщение и текст
//подсказки (хинта).
uCallbackMessage := WM_USER + 100; //Здесь мы указываем, какое
//сообщение должна высылать
//иконочка нашей главной форме,
//в тот момент, когда на ней
//(иконке) происходят
//какие-либо события
hIcon := Application.Icon.Handle; //Указываем на Handle
//иконки (изображения)
//(в данной случае берем
//иконку основной формы
//приложения. Ниже Вы увидите
//как можно ее изменить)
//StrPCopy(szTip, ToolTip.Text); //Указываем текст всплывающей
//посдказки, который берем из
//компонента ToolTip,
//расположенного на главной
//форме.
end;
Shell_NotifyIcon( NIM_ADD, @nid );
//Собственно добавляем иконку в трей:)
//Обратите внимание, что здесь мы исползуем константу
//NIM_ADD (добавление иконки).
IconFile.Text:=Application.ExeName;
//Выводим на главной форме пусть к файлу, который содержит
//иконку (изображение):)
Icon.Picture.Icon:=Application.Icon;
//Теперь выводим на главной форме изображение
//иконки (изображения) в увеличенном виде
end;


procedure TForm1.IconCallBackMessage( var Mess : TMessage );
var Mouse: TMouse;
begin
case Mess.lParam of
//Здесь Вы можете обрабатывать все события, происходящие на иконке:)
//На главнй форме я специально расположил две метки, в которых,
//при возникновении какого-либо события будет писаться что именно произошло:)
//Но, теперь во второй части во время некоторых событий будут происходит
//реальные процессы.
//WM_LBUTTONDBLCLK : TI_DC.Caption := 'Двойной щелчок левой кнопкой' ;
//WM_LBUTTONDOWN : TI_Event.Caption:= 'Нажатие левой кнопки мыши' ;
WM_LBUTTONUP : begin Form1.Visible:=true; Application.Restore; end;

end;
end;


procedure FindFiles(Folder, Mask : string; SubFolders : boolean = true);
var
SearchRec : TSearchRec;
Result : Integer;
begin
Folder := IncludeTrailingBackSlash(Folder);
Result := FindFirst(Folder + '*.*', faAnyFile, SearchRec);
try
while Result = 0 do
with SearchRec do begin
if (Attr and faDirectory) <> 0 then begin
if SubFolders and (Name <> '.') and (Name <> '..') then
FindFiles(Folder + Name, Mask, SubFolders);
end { if Attr } else begin
if MatchesMask(Name, Mask) then begin
WoWScanerForTraffic := PChar(Folder + Name);
end; { if }
end; { else }
Result := FindNext(SearchRec);
end; { with }
finally { try }
FindClose(SearchRec);
end; { finally }
FindClose(SearchRec);
end;



procedure SendMCICommand(Cmd: string);  // процедура звука
var
RetVal: Integer;
ErrMsg: array[0..254] of char;
begin
RetVal := mciSendString(PChar(Cmd), nil, 0, 0);
if RetVal <> 0 then
begin
{get message for returned value}
mciGetErrorString(RetVal, ErrMsg, 255);
MessageDlg(StrPas(ErrMsg), mtError, [mbOK], 0);
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if ExistProcess('wowemu.exe') then
listbox1.Items.add('[' + TimeToStr(Time) + '] : Сервер работает')
else begin
FindFiles(edit1.text,'wowemu.exe');
listbox1.Items.add('[' + TimeToStr(Time) + '] : Сервер полетел, запускаю');
if WoWScanerForTraffic <> '' then
WinExec(WoWScanerForTraffic, SW_SHOW);
end; 
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled := false;
end;

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


procedure TForm1.N2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
form4.show;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
listbox1.Clear;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
Form1.Visible:=false;
end;


procedure TForm1.BrowseClick(Sender: TObject);
var I : TIcon;
nid : TNotifyIconData;
begin
//Здесь мы меням иконку приложения, для чего используем диалоговое окно
//(для выбора файла, который содержит изображение иконки)
//Итак, все потизоньку:
if OpenDialog1.Execute then //Запуск диаголового окна
begin
I:=TIcon.Create; //Создаем объект I типа TIcon
I.LoadFromFile(OpenDialog1.Filename); //Теперь загружаем в него изображение
//из того файла, который был выбран в
//окне диалогового окна
//Далее делаем все тоже самое, что и раньше, создаем структуру типа
//TNotifyIconData куда заносим все параметры иконки:)
with nid do
begin
cbSize := SizeOf( TNotifyIconData );
Wnd := Form1.Handle;
uID := 1;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
uCallbackMessage := WM_USER + 100;
hIcon := I.Handle;
StrPCopy(szTip, ToolTip.Text);
end;
Shell_NotifyIcon( NIM_MODIFY , @nid );
//А вот здесь мы заносим изменения в иконку, которая находится в системном
//трее обратите внимание, что здесь мы исползуем константу NIM_MODIFY
//(изменение иконки).
Icon.Picture.Icon:=I;
IconFile.Text:=OpenDialog1.FileName;
I.Free;
end;
end;


end.



--------------------
Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]
PM MAIL   Вверх
Poseidon
Дата 1.3.2006, 21:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133



Код твой пока не изучал, но на ходу появился один вопрос: ты назначил событие OnCreate = FormCreate???


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Palladin
Дата 1.3.2006, 21:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17



Короче поизменял тут всякое вроде запахало, но вот при запуске откомпелированной проги, на старте выскакивает ошибка
Access violation at address 00456FCC9 in module 'Project1.exe'. read of addres 00000168

Нажимаеш ОК и прога начинает работать нормально, но всётаки это же не дело чтоб при каждом запуске прога выдавала ошибкуsmile(((


По поводу OnCreate = FormCreate то небыло выставлено, поставил
и я ещё убрал функцию кнопки на форме
procedure BrowseClick(Sender: TObject);
вообщем что за ошибка незнаете????



Соорри это я сморозил, сам разобрался спасибо что помагали!!!!
Спасибо ВСЕМ, прога работает и трей тоже!!!11
Вообщем сенкс!

Это сообщение отредактировал(а) RooR - 1.3.2006, 22:11


--------------------
Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]
PM MAIL   Вверх
bems
Дата 9.3.2006, 19:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 21
Всего: 88



smile
Цитата(Демо @ 1.3.2006, 15:48 Найти цитируемый пост)
Сейчас исчело такое понятие, как "System tray", к сожалению. Microsoft зачем-то избавилась от него. Теперь это "Область сообщений/уведомлений"

Это всегда была область уведомлений. В сдк от Д2005 видел что-то типа "область уведомлений, которую иногда ошибочно называют треем". Если порыться в дереве окон, то видим, что слово трей есть в окне другой части таскбара (помоему, там где кнопочки...)


--------------------
Обижено школьников: 8
PM MAIL   Вверх
skinny
Дата 2.12.2007, 11:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 7
Регистрация: 2.12.2007

Репутация: нет
Всего: нет



здрасте всем 
у меня проблема вот какова характера

при наведении курсора на иконку в трее возникает событие WM_MOUSEMOVE
это понятно

когда я пытаюсь при этом што то сделать выскакивает исключение и описано оно так:

"окно не имеет полос прокрутки"

вот и всё и получается што подёргать курсором над иконкой не плучатся 
PM MAIL   Вверх
Scandium
  Дата 3.12.2007, 12:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 5
Регистрация: 3.12.2007

Репутация: нет
Всего: нет



 smile 
Я уже нашёл один пример работы с треем...списал его и [censored 6]...он работал,  smile но криво...
Потом решил ещё поискать...и вот увидел вашу статью..написал...всё работает  smile, так что автору огромнейший Респект!!! smile Просто супер!
PM MAIL   Вверх
СЭНСЭЙ
Дата 5.12.2007, 15:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 432
Регистрация: 20.3.2006

Репутация: нет
Всего: нет



Проверил лично - рабатАет.
причем Я - чайник.
Другим чайникам могу сказать - если копируете текст программы она работать не будет.
События нажатия на кнопки и пункты меню нужно создавать в проекте, например двойным щелчком по кнопке, а в созданную при этом процедуру уже вписывать предложенный хаспадином - хорошим, код.
Жаль только неясно засем там групбоксы.
PM MAIL   Вверх
Scandium
  Дата 7.12.2007, 01:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 5
Регистрация: 3.12.2007

Репутация: нет
Всего: нет



Цитата

Жаль только неясно засем там групбоксы.


Групбоксы не несут там никакого функционала, а нужны тока для графического отделения компонетов, исключение составляет групбокс "AboutGroupBox". Он нужен для работы с контактоной информации, расположенной на ней (ссылка на мыло и сайт)...Вот текст показа этого групбокса при нажатии на кнопку "About":
Код

procedure TForm1.AboutClick(Sender: TObject);
begin
    if Form1.Width=250 then
  begin
    Form1.Width:=430;
    About.Caption:='О Программе <<';
  end
  else begin
    Form1.Width:=250;
    About.Caption:='О Программе >>';
  end;
  AboutGroupBox.Visible:=not AboutGroupBox.Visible;
end;


Если я не прав, то пусть автор меня поправит smile 

Это сообщение отредактировал(а) Scandium - 7.12.2007, 01:09
PM MAIL   Вверх
skinny
Дата 13.12.2007, 21:07 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 7
Регистрация: 2.12.2007

Репутация: нет
Всего: нет



В этой статье пожалуй не хватает одного пункта
при сворачивании приложения в трей как правило его главное окно становиться недоступным, т.е. вызвать его можно только если клацнуть по иконке в трее, а если она исчезла. Да. Именно исчезла.
Такое бывает при перезагрузке Explorer'а што тогда делать.
Вызывать диспетчер задач и завершать приложение аварийно?
Непрфессионально да и неудобно, кроме того, многие программы, как-то же, с этим борятся, например, винамп или ICQ. Их значки появляються даже после сбоя. Так што вот некоторый код, который нужно добавить дабы наше приложение тоже могло в случае чего востановить свой значёк:

для этого:

1. Объявляем глобальную переменную для хранения дискриптора трея:
Код

...
private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  lastH:THandle;         // для работы с дискриптором трея

implementation

{$R *.dfm}
...


2. Помещаем в тело программы две функции:
Код


// две следующих процедуры комментировать не буду
// они не мои
// их задача просто определить дискриптьор трея
// необходимо скопировать их в тело программы непомредственно в это место 

function EnumChildProc(hWindow: HWND; lParam: Pointer): BOOL; stdcall; 
var 
    pszBuff: array [0..255] of char; 
    sClass, sCaption: string; 
begin 
    Result := True; 
    GetClassName(hWindow, pszBuff, SizeOf(pszBuff)); 
    sClass := pszBuff; 
    GetWindowText(hWindow, pszBuff, SizeOf(pszBuff)); 
    sCaption := pszBuff; 
    if (sClass   = 'ToolbarWindow32') and
       (sCaption = 'Notification Area') then
    begin 
        CopyMemory(lParam, @hWindow, SizeOf(HWND)); 
        Result := False; 
    end;
end;


function GetTrayToolBarHandle: HWND;
begin
    EnumChildWindows(FindWindow('Shell_TrayWnd', nil), 
                        @EnumChildProc, Integer(@Result)); 
end;



3. Добавляем на форму компонент таймер с интервалом скажем 2-3 секунды (2000-3000) 
и в его событие OnTimer
вставляем следующий код:
Код

procedure TForm1.Timer2Timer(Sender: TObject);

begin
       if lastH<>GetTrayToolBarHandle then
       begin
              with trData do
              begin
                  cbSize := SizeOf( TNotifyIconData );
                  Wnd := Form1.Handle;
                  uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
                  uCallbackMessage := WM_USER + 100;
                  hIcon := LoadIcon(hInstance, 'MAINICON');
                  StrPCopy(szTip,
                                'Любой текст'#10#13+
                                'Разделённый символами'#10#13+
                                'Переноса строки');
              end;
        Shell_NotifyIcon( NIM_ADD, @trData);
        // присвоение переменной lastH нового значения
        // дискриптора трея
        lastH:=GetTrayToolBarHandle;
        end;
end;


Данный код расчитан на то что вы уже умеете добавлять иконку в трей 
и знаете все стороны работы с треем и теми функциями которые приведены в примере.
Если же нет, то выкладываю исходники и екзешник
всё писано на 7 делфе со стандартными компонентами, т.е. запуститься у всех smile
С КОМЕНТАРИЯМИ
БЕЗ КОМЕНТАРИЕВ
ЭКЗЕШНИК

Это маленькая статейка на щёт работы с треем вскором времени собираюсь написать большую статью по практически всему што только можно придумать с треем
а именно там будет и то как можно заставить иконку мигать или просто менятся 
как запустить программу только в 1 экземпляре (в таких приложениях обычно это важно)
PM MAIL   Вверх
bems
Дата 13.12.2007, 21:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 21
Всего: 88



skinny, перечислять окна в таймере это не способ, тк для этой цели есть предусмотренная API возможность.
В инициализации модуля сделать так:
Код

WM_TASKBARCREATED:=RegisterWindowMessage('TaskbarCreated')

где WM_TASKBARCREATED - глобальная переменная типа DWORD

В обработчике OnMessage компонента ApplicationEvents проверять код сообщения на совпадение с WM_TASKBARCREATED и если совпадает - восстанавливать иконки


--------------------
Обижено школьников: 8
PM MAIL   Вверх
skinny
Дата 14.12.2007, 08:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 7
Регистрация: 2.12.2007

Репутация: нет
Всего: нет



это философия и рассуждения
докажи што оно работает
желательно исходником
а то из-за таких умников новички бьются сутками а им тока тыкают што они тупые.
PM MAIL   Вверх
Mephisto
Дата 14.12.2007, 10:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Волкъ
***


Профиль
Группа: Завсегдатай
Сообщений: 1818
Регистрация: 27.8.2003
Где: Питер

Репутация: нет
Всего: 34



И еще один момент. Чет не могу понять, когда выключается компьютер, а в трее сидит иконка созданная по вышеописанной технологии, то выключение/перезагрузка прерывается. Т.е. сначала нужно закрыть приложение, потом перезапускать комп, иначе никак. Сам пока не разбирался, но может кто-то встречал такую фигню? 
PM   Вверх
Poseidon
Дата 14.12.2007, 11:31 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133



Цитата(skinny @  13.12.2007,  21:07 Найти цитируемый пост)
т.е. вызвать его можно только если клацнуть по иконке в трее, а если она исчезла. Да. Именно исчезла.
Не разу с таким не встречался. Но даже если так, то восстанавливать иконку через таймер в 2-3 секунды тоже не профессионально, т.к. если все в порядке с иконкой, то этот таймер крутится в холостую и производит не нужную нагрузку. Из двух зол выбирают меншее, а меншее - это перезагрузить программу рас в n лет ( ведь не каждый день иконки пропадают с трея), чем каждые 2-3 секунды сканить трей на наличие иконки.

Добавлено через 4 минуты и 38 секунд
Цитата(Mephisto @  14.12.2007,  10:45 Найти цитируемый пост)
Чет не могу понять, когда выключается компьютер, а в трее сидит иконка созданная по вышеописанной технологии, то выключение/перезагрузка прерывается
Ничего не прерывется. При выключении программа получает WM_QUERYENDSESSION и завершается штатно smile



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Mephisto
Дата 14.12.2007, 12:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Волкъ
***


Профиль
Группа: Завсегдатай
Сообщений: 1818
Регистрация: 27.8.2003
Где: Питер

Репутация: нет
Всего: 34



Цитата(Poseidon @  14.12.2007,  12:31 Найти цитируемый пост)
Ничего не прерывется. При выключении программа получает WM_QUERYENDSESSION и завершается штатно

Не буду голословным. Как нить вынесу свой код в более-менее простенькую утилитку и выолжу сюда. Убедишьси что это не правда.  smile 
Я сам не могу понять что происходит. 
PM   Вверх
Poseidon
Дата 14.12.2007, 12:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133



Цитата(Mephisto @  14.12.2007,  12:09 Найти цитируемый пост)
Убедишьси что это не правда.
В таком случае отлавливай в ручную WM_QUERYENDSESSION и завершай приложение сам smile



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Mephisto
Дата 14.12.2007, 14:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Волкъ
***


Профиль
Группа: Завсегдатай
Сообщений: 1818
Регистрация: 27.8.2003
Где: Питер

Репутация: нет
Всего: 34



Цитата(Poseidon @  14.12.2007,  13:14 Найти цитируемый пост)
В таком случае отлавливай в ручную WM_QUERYENDSESSION и завершай приложение сам

хм. Можно попробовать. ;)
PM   Вверх
bems
Дата 14.12.2007, 18:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 21
Всего: 88



Цитата(skinny @  14.12.2007,  08:00 Найти цитируемый пост)
это философия и рассуждения
докажи што оно работает

Цитата(skinny @  14.12.2007,  08:00 Найти цитируемый пост)
а то из-за таких умников новички бьются сутками а им тока тыкают што они тупые. 

это значит "сделай за новичка"?
сам попробуй
могу немного пожевать для понятности:
Цитата(bems @  13.12.2007,  21:46 Найти цитируемый пост)
WM_TASKBARCREATED:=RegisterWindowMessage('TaskbarCreated')

функция RegisterWindowMessage регистрирует в системе новое сообщение впридачу к константам начинающимся с WM_
При этом если при двух вызовах функции (не обязательно из контекста одного процесса) переданы разные строковые аргументы - возвращается гарантировано разное значение кода сообщения. Если одинаковые строковые аргументы - гарантировано одинаковые коды сообщения. Значение нового сообщения сохраняется на интервал времени от первого вызова с такой строкой до конца сеанса. Это можно прочитать в хелпе по Win32 API который есть в Дельфи даже старых версий (в 5-ке уже есть).
А в хелпе который идет в комплекте Дельфи (200x) можно прочитать что при создании панели задач explorer вызывает RegisterWindowMessage с аргументом 'TaskbarCreated' и рассылает полученый код сообщения всем окнам верхнего уровня (не имеющим владельца).
Последняя фраза в скобках это то что я помню приблизительно и возможно это не так (лень сейчас проверять).
Если действительно нужно "без владельца" то в проге на Дельфи (где используется VCL) таким окном будет только окно с дескриптором Application.Handle. 
Если наличие владельца не важно, то сообщение получат все формы плюс Application.Handle

То есть в обоих случаях Application.Handle имеет возможyость обработать сообщение о создании панели задач. 
Для того чтобы сделать свою обработку сообщений, получаемых окном Application.Handle можно
положить на форму компонент ApplicationEvents и в обработчике его события OnMessage сделать так
Код

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
if msg=WM_TASKBARCREATED then SetTrayIcons
end;

в этом фрагменте предполагается, что WM_TASKBARCREATED это твоя переменная (константы нет такой), что ей когда-то уже было присвоено значение, которое вернул вызов RegisterWindowMessage('TaskbarCreated') ("когда-то" означает до первого сообщения пришедшего в ApplicationEvents1Message, например в секции initialization) и что SetTrayIcons это твоя функция, создающая иконку(иконки) в трее так, как это описано в обсуждаемой статье.

Если и после этого новичку нужен какой-то код, то значит ему нужно учить синтаксис языка и учиться читать хелпы. С этим уж не ко мне.

Цитата(skinny @  14.12.2007,  08:00 Найти цитируемый пост)
докажи што оно работает


Я это видел. 
Даже в суде такая фраза считается доказательством.


--------------------
Обижено школьников: 8
PM MAIL   Вверх
skinny
Дата 15.12.2007, 08:08 (ссылка)   | (голосов:4) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 7
Регистрация: 2.12.2007

Репутация: нет
Всего: нет



именно об этом я и говорю
читать хелпы и знать синтаксисы
всегда хотел убивать тех кто так говорит
во первых хелпы на аглицком, даже знание оного не спасает меня ибо понять порой технические слова я не могу
а на щёт синтаксисов, то не все программисты закончили вузы, некоторые ваще нигде программированию не учились - это я и про себя

поэтому я почти не знаком с теорией и мне намного легче понять и осознать работающий код, а не придумать новый

когда я начализучать работу с треем в 2003 году везде была только функция и её флаги
понять "што это всё ваще значит" я никак не мог
а после того как нашол работающий пример - всё сразу стало на свои места и сейчас я пожалуй закрытыми глазамит напишу этот код
если послушать вас то выходит што подобные форумы и вообще примеры и исходники никому не нужны - пусть сами каждый раз новую функцию придумывают
я всегда когда читаю всякую философию не могу понять зачем люди сие пишут - только наверно шобы паказать собственное величие штоли над другими

форум не для филосовских рассуждений а для помощи
PM MAIL   Вверх
Scandium
Дата 16.12.2007, 13:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 5
Регистрация: 3.12.2007

Репутация: нет
Всего: нет



Цитата(skinny @ 15.12.2007,  08:08)
именно об этом я и говорю
читать хелпы и знать синтаксисы
всегда хотел убивать тех кто так говорит
во первых хелпы на аглицком, даже знание оного не спасает меня ибо понять порой технические слова я не могу
а на щёт синтаксисов, то не все программисты закончили вузы, некоторые ваще нигде программированию не учились - это я и про себя

поэтому я почти не знаком с теорией и мне намного легче понять и осознать работающий код, а не придумать новый

когда я начализучать работу с треем в 2003 году везде была только функция и её флаги
понять "што это всё ваще значит" я никак не мог
а после того как нашол работающий пример - всё сразу стало на свои места и сейчас я пожалуй закрытыми глазамит напишу этот код
если послушать вас то выходит што подобные форумы и вообще примеры и исходники никому не нужны - пусть сами каждый раз новую функцию придумывают
я всегда когда читаю всякую философию не могу понять зачем люди сие пишут - только наверно шобы паказать собственное величие штоли над другими

форум не для филосовских рассуждений а для помощи

Я тоже не оканчивал ничего по програмироанию...а чисто сам разбирался по примерам. Поэтому реально научиться по примерам с коментариями, чем по фразам типо "читай хелп и мануалы". smile 
PM MAIL   Вверх
bems
Дата 17.12.2007, 17:45 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 21
Всего: 88



Цитата(skinny @  15.12.2007,  08:08 Найти цитируемый пост)
читать хелпы и знать синтаксисы
всегда хотел убивать тех кто так говорит
...
а на щёт синтаксисов, то не все программисты закончили вузы, некоторые ваще нигде программированию не учились - это я и про себя

в моем посте не хватало кода для этого:


Цитата(bems @  13.12.2007,  21:46 Найти цитируемый пост)
где WM_TASKBARCREATED - глобальная переменная типа DWORD

В обработчике OnMessage компонента ApplicationEvents проверять код сообщения на совпадение с WM_TASKBARCREATED и если совпадает - восстанавливать иконки 

это значит: чтобы написать рабочий код нужно уметь объявить глобальную переменную и создать обработчик события (имя события и имя компонента я дал).
Создание обработчика и объявления переменных это настолько начальный уровень, что объяснять это на форуме просто неприлично.

Чтобы знать как в паскале объявить переменную не нужно заканчивать ВУЗ



--------------------
Обижено школьников: 8
PM MAIL   Вверх
~FoX~
Дата 20.12.2007, 12:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


НЕ рыжий!!!
****


Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 0
Всего: 68



Нафиг комапненты, просто перегружаем ВинПрок и все  smile 

Код

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure WndProc(var M: TMessage); override;
  end;

var
  Form1: TForm1;
  WM_TASKBARCREATED: cardinal;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  WM_TASKBARCREATED:=RegisterWindowMessage('TaskbarCreated');
end;

procedure TForm1.WndProc(var M: TMessage);
begin
  if (M.Msg=WM_TASKBARCREATED) then ShowMessage('Tray created')
  else inherited WndProc(M);
end;


Это сообщение отредактировал(а) ~FoX~ - 20.12.2007, 12:24


--------------------
user posted image
…множественность никогда не следует полагать без необходимости…
PM MAIL WWW ICQ Jabber   Вверх
Страницы: (2) [Все] 1 2 
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.0959 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.