Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как свернуть окно в "Область уведомлений" (правый нижний угол)? [Win2k, WinXP]


BaG ©   (2004-07-30 01:29:00) 

Как свернуть окно в "Область уведомлений" (правый нижний угол)?

Rocket   (2004-08-05 19:14:00) [1]

Огромное спасибо! Сам бы не нашёл ;)

Мастер   (2004-08-05 15:40:00) [2]

http://www.swissdelphicenter.ch/torry/printcode.php?id=1164

Rocket   (2004-08-05 14:40:00) [3]

А как отображать Hint'ы над иконкой длиной больше 64 знаков?

panov   (2004-08-02 09:40:00) [4]

>GrayFace ©   (31.07.04 18:18) [8]
А где гарантия, что там будут "часики"? Их может и не быть.
>Германн ©   (01.08.04 02:20) [9]

Ну, как понимаешь, если их там нет, то это нестандартная ситуация, которую мы не рассматриваем.

А пофлеймить можно и в "Потрепаться"

Германн   (2004-08-01 02:47:00) [5]

2 panov ©   (30.07.04 10:27) [6]
А вообще приму Ваше решение к сведению. Очень может быть, что и пригодится.
Лишь бы не было возражений от других!

Германн   (2004-08-01 02:20:00) [6]

2 GrayFace ©   (31.07.04 18:18) [8]
>Германн ©   (30.07.04 3:16) [3]
>А где гарантия, что там будут "часики"? Их может и не быть.

Дык и я о том же!

Не говоря уже о том, что "Свернуть окно" в Tray или в "Область уведомлений" - невозможно. Так что Panov проявил слишком большое благодушие постируя решение.
Имхо, отдыхая от модераторских функций. Ну или ...

GrayFace   (2004-07-31 18:18:00) [7]

Германн ©   (30.07.04 3:16) [3]
А где гарантия, что там будут "часики"? Их может и не быть.

panov   (2004-07-30 10:27:00) [8]


unit fMainDisp;

interface

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

var
 WM_MyNotifyIcon: Cardinal;

type
 TRec=record
   MenuStr,PathStr,CommentStr: String;
 end;

 TMainDisp = class(TForm)
   mm: TMainMenu;
   mmQuit: TMenuItem;
   mmApps: TMenuItem;
   mmSettings: TMenuItem;
   N11: TMenuItem;
   N21: TMenuItem;
   pmIconTray: TPopupMenu;
   N12: TMenuItem;
   N22: TMenuItem;
   N1: TMenuItem;
   procedure FormCreate(Sender: TObject);
   procedure mmQuitClick(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure mmSettingsClick(Sender: TObject);
   procedure OnStartAppsClick(Sender: TObject);
   procedure MyWndProc(var Message: TMessage); //процедура, перекрывающая
                                               //стандартную оконную процедуру

   procedure IconTray(aAction: Cardinal);
   procedure pmIconTrayRestoreClick(Sender: TObject);
   procedure pmIconTrayExitClick(Sender: TObject);
   procedure OnMinimize(Sender: TObject);
 private
   { Private declarations }
 public
   procedure SetMenuApps;
   procedure LoadMenuApps;
   procedure SaveMenuApps;
   procedure LoadFormPos;
   procedure SaveFormPos;

 end;

var
 MainDisp: TMainDisp;
 Apps: array of TRec;
 AppsCounter: Integer;

implementation

uses uIni, ufSettings;

{$R *.dfm}

//Функция для создания нового процесса
//Параметры:
// aCommand:  Строка для выполнения исполняемого файла(полный путь)
// aShow:     Показывать/не показывать окно нового процесса
// aWaitExit: Ожидать/не ожидать завершения процесса
function ExecCmd(const aCommand: String;const aShow, aWaitExit: Boolean): Boolean;
var
 pi:PROCESS_INFORMATION;
 si:STARTUPINFO;
 cmdLine,Path: String;
begin
 ZeroMemory(@si,sizeof(si));
 si.cb:=SizeOf(si);
 si.dwFlags := STARTF_FORCEONFEEDBACK+STARTF_USESHOWWINDOW;
 if aShow then si.wShowWindow := SW_SHOWNORMAL else si.wShowWindow := SW_HIDE;
 Path := ExtractFilePath(aCommand);
 cmdLine := aCommand;

 Result :=
        CreateProcess( nil,             // No module name (use command line).
                       PChar(cmdLine),  // Command line.
                       nil,             // Process handle not inheritable.
                       nil,             // Thread handle not inheritable.
                       False,           // Set handle inheritance to FALSE.
                       0,               // No creation flags.
                       nil,             // Use parent's environment block.
                       PChar(Path),     // Use parent's starting directory.
                       si,              // Pointer to STARTUPINFO structure.
                       pi );             // Pointer to PROCESS_INFORMATION structure.
 if Result then
 begin
   if aWaitExit then WaitForSingleObject( pi.hProcess, infinite );
   CloseHandle(pi.hThread);
   CloseHandle(pi.hProcess);
 end;
end;

procedure TMainDisp.LoadMenuApps;
var
 s: String;
 i: Integer;
begin
 s := GetParm('Apps','Count');
 if s='' then s := '0';
 AppsCounter := StrToInt(s);
 SetLength(Apps,AppsCounter);
 for i := 0 to AppsCounter-1 do
 begin
   Apps[i].MenuStr := GetParm('Apps','MenuStr'+IntToStr(i));
   Apps[i].PathStr := GetParm('Apps','PathStr'+IntToStr(i));
   Apps[i].CommentStr := GetParm('Apps','CommentStr'+IntToStr(i));
 end;
end;

procedure TMainDisp.SaveMenuApps;
var
 i: Integer;
begin
 DeleteSection('Apps');
 WriteParm('Apps','Count',IntToStr(AppsCounter));
 for i := 0 to AppsCounter-1 do
 begin
   WriteParm('Apps','MenuStr'+IntToStr(i),Apps[i].MenuStr);
   WriteParm('Apps','PathStr'+IntToStr(i),Apps[i].PathStr);
   WriteParm('Apps','CommentStr'+IntToStr(i),Apps[i].CommentStr);
 end;
end;

procedure TMainDisp.SetMenuApps;
var
 i: Integer;
 MI: TMenuItem;
begin
 for i := 0 to mm.Items[0].Count-1 do mm.Items[0].Items[0].Free;
 for i := 3 to pmIconTray.Items.Count-1 do pmIconTray.Items[0].Free;

 for i := 0 to AppsCounter-1 do
 begin
   MI := TMenuItem.Create(mm);
   MI.Caption := Apps[i].MenuStr;
   MI.OnClick := OnStartAppsClick;
   MI.Hint := Apps[i].CommentStr;
   MI.Tag := i;
   mm.Items[0].Add(MI);
   MI := TMenuItem.Create(pmIconTray);
   MI.Caption := Apps[i].MenuStr;
   MI.OnClick := OnStartAppsClick;
   MI.Tag := i;
   pmIconTray.Items.Add(MI);
 end;
end;

procedure TMainDisp.LoadFormPos;
var
 s: String;
begin
 s := GetParm('Forms','MainDispLeft');
 if s='' then s := '1';
 MainDisp.Left := StrToInt(s);
 s := GetParm('Forms','MainDispTop');
 if s='' then s := '1';
 MainDisp.Top := StrToInt(s);
 s := GetParm('Forms','MainDispHeight');
 if s='' then s := '60';
 MainDisp.Height := StrToInt(s);

 MainDisp.Width := 220;

 if (MainDisp.Left<0) or
    (MainDisp.Left>Screen.Width-MainDisp.Width) then
    MainDisp.Left := 1;

 if (MainDisp.Top<0) or
    (MainDisp.Top>Screen.Height-MainDisp.Height) then
    MainDisp.Top := 1;
end;

panov   (2004-07-30 10:27:00) [9]


procedure TMainDisp.SaveFormPos;
begin
 WriteParm('Forms','MainDispLeft',IntToStr(MainDisp.Left));
 WriteParm('Forms','MainDispTop',IntToStr(MainDisp.Top));
 WriteParm('Forms','MainDispWidth',IntToStr(MainDisp.Width));
 WriteParm('Forms','MainDispHeight',IntToStr(MainDisp.Height));
end;

procedure TMainDisp.MyWndProc(var Message: TMessage);
var
 P: TPoint;
begin
 //Обработка сообщения от иконки в SysTray
 if Message.Msg = WM_MyNotifyIcon then
 begin
   case Message.LParam of

     WM_LBUTTONDBLCLK :
       begin
         //Восстанавливаем приложение
         ShowWindow(Application.Handle,SW_RESTORE);
         //Восстанавливаем основную форму
         ShowWindow(Application.MainForm.Handle,SW_RESTORE);
         //Приложение - на передний план
         SetForegroundWindow(Application.MainForm.Handle);
         //Удаляем иконку
         IconTray(NIM_DELETE);
       end;
     //Клик на правой кнопке мыши
     WM_RBUTTONUP:
     begin
       //Считываем позицию курсора на экране
       GetCursorPos(P);
       //Приложение - на передний план
       SetForegroundWindow(Application.MainForm.Handle);
       //Показываем меню в позиции курсора
       pmIconTray.Popup(P.X, P.Y);
     end;
   end;
   //Заканчиваем обработку
   Message.Result := 0;
   Exit;
 end;
 //Обработка нажатия на кнопку свернуть в заголовке окна
 if (Message.Msg=WM_SYSCOMMAND) and
    (Message.wParam = SC_MINIMIZE) then
 begin
   //Добавляем иконку
   IconTray(NIM_ADD);
   //Скрываем основную форму
   ShowWindow(Application.MainForm.Handle,SW_HIDE);
   //Скрываем приложение
   ShowWindow(Application.Handle,SW_HIDE);
   //Заканчиваем обработку
   Message.Result := 0;
   Exit;
 end;
 //Не наше сообщение - вызываем стандартную процедуру окна
 WndProc(Message);
end;

procedure TMainDisp.IconTray(aAction: Cardinal);
var
 nid: TNotifyIconData;
begin
//Заполнение структуры
 nid.cbSize := SizeOf(TNotifyIconData);    //Размер структуры
 nid.Wnd := Self.Handle;                   //Окно назначения
 nid.uID := 0;                             //Назначаем идентификатор иконке
 nid.uCallBackMessage := WM_MyNotifyIcon;  //Процедура для обработки сообщений
 nid.hIcon := Application.Icon.Handle;     //Это основная иконка приложения
 StrPCopy(nid.szTip,Application.Title);    //Всплывающая подсказка (Hint)
//Признаки:
//  NIF_ICON    - используется поле nid.hIcon
//  NIF_MESSAGE - используется сообщение с номером nid.uCallBackMessage для обработки
//  NIF_TIP     - для иконки назначен Hint - всплывающая подсказка.
 nid.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
 case aAction of
   NIM_ADD:  Shell_NotifyIcon(NIM_ADD, @nid);        //Добавление иконки
   NIM_DELETE:  Shell_NotifyIcon(NIM_DELETE, @nid);  //Удаление иконки
   NIM_MODIFY:  Shell_NotifyIcon(NIM_MODIFY, @nid);  //Модификация иконки
 end;
end;

procedure TMainDisp.FormCreate(Sender: TObject);
var
 UniqueStr: String;
begin
 Application.Title := Self.Caption;
 UniqueStr := Application.Title+IntToStr(Application.Handle);
//Получаем уникальный номер Windows-сообщения.
 WM_MyNotifyIcon := RegisterWindowMessage(PChar(UniqueStr));
//Заменяем обработчик стандартный обработчик сообщений на наш
 WindowProc := MyWndProc;
 LoadFormPos;
 LoadMenuApps;
 SetMenuApps;
 Application.OnMinimize := OnMinimize;
end;

procedure TMainDisp.mmQuitClick(Sender: TObject);
begin
 Close;
end;

procedure TMainDisp.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 SaveFormPos;
end;

procedure TMainDisp.mmSettingsClick(Sender: TObject);
begin
 with TfSettings.Create(Application) do
 begin
   try
     ShowModal;
   finally
     Free;
   end;
 end;
end;

procedure TMainDisp.OnStartAppsClick(Sender: TObject);
begin
 ExecCmd(Apps[(Sender as TMenuItem).Tag].PathStr,True,False);
end;

procedure TMainDisp.pmIconTrayRestoreClick(Sender: TObject);
begin
 PostMessage(Application.MainForm.Handle,WM_MyNotifyIcon,0,WM_LBUTTONDBLCLK);
end;

procedure TMainDisp.pmIconTrayExitClick(Sender: TObject);
begin
//Восстанавливаем приложение
 PostMessage(Application.MainForm.Handle,WM_MyNotifyIcon,0,WM_LBUTTONDBLCLK);
//Закрываем приложение
 Application.MainForm.CLose;
end;

procedure TMainDisp.OnMinimize(Sender: TObject);
begin
   //Добавляем иконку
   IconTray(NIM_ADD);
   //Скрываем основную форму
   ShowWindow(Application.MainForm.Handle,SW_HIDE);
   //Скрываем приложение
   ShowWindow(Application.Handle,SW_HIDE);
   //Заканчиваем обработку

end;

end.

grom   (2004-07-30 08:51:00) [10]

TrayIcon
http://denisov.i2x2.ru/delphi/units.htm

KADAN   (2004-07-30 04:20:00) [11]

http://delphimaster.ru/cgi-bin/faq.pl?look=1&id=988624981&n=15

Германн   (2004-07-30 03:16:00) [12]

Вот непонятно! Почему, когда спрашивали о Tray, всегда добавляли "там, где часики"?
А когда речь пошла о "Область уведомлений" (правый нижний угол), уточнений нет? Ведь где гарантия, что оная будет "в правом нижнем углу"?

Традиция незнающих английский, даже в примитиве?

BaG   (2004-07-30 02:07:00) [13]

Спасибо за совет

GanibalLector   (2004-07-30 01:45:00) [14]

Ну...компоненты можно использовать сторонние.Например RxLib

Наверх

Титульная страница Поиск, карта сайта Написать письмо