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

Вниз

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

← →
BaG ©   (2004-07-30 01:29) [0]

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

---

← →
GanibalLector ©   (2004-07-30 01:45) [1]

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

---

← →
BaG ©   (2004-07-30 02:07) [2]

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

---

← →
Германн ©   (2004-07-30 03:16) [3]

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

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

---

← →
KADAN ©   (2004-07-30 04:20) [4]

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

---

← →
grom   (2004-07-30 08:51) [5]

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

---

← →
panov ©   (2004-07-30 10:27) [6]


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) [7]


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.


---

← →
GrayFace ©   (2004-07-31 18:18) [8]

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

---

← →
Германн ©   (2004-08-01 02:20) [9]

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

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

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

---

← →
Германн ©   (2004-08-01 02:47) [10]

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

---

← →
panov ©   (2004-08-02 09:40) [11]

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

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

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

---

← →
Rocket   (2004-08-05 14:40) [12]

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

---

← →
Мастер ©   (2004-08-05 15:40) [13]

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

---

← →
Rocket   (2004-08-05 19:14) [14]

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

---

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

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

Наверх

Память: 0.52 MB
Время: 0.062 c