Форум: "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