Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2004.09.19;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.09.19;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.51 MB
Время: 0.031 c
8-1088269863
Marser
2004-06-26 21:11
2004.09.19
Панель управления. Свойства:Звук


4-1091719149
_Stalker_
2004-08-05 19:19
2004.09.19
SendMessage


4-1091203693
delphiserg
2004-07-30 20:08
2004.09.19
Принтери


14-1093733259
Тупой
2004-08-29 02:47
2004.09.19
Кто небуть научите работать с Delphi 7!!!


1-1094298121
dr Tr0jan
2004-09-04 15:42
2004.09.19
Хранение и передача массива из DLL в программу





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский