21.04.2009, 09:15
|
Активный
|
|
Регистрация: 29.03.2009
Сообщения: 300
Репутация: 94
|
|
Вот примерно как-то так:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ShellAPI;
const
WM_MYICONNOTIFY = WM_USER + 123;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Hide1: TMenuItem;
Restore1: TMenuItem;
Exit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Hide1Click(Sender: TObject);
procedure Restore1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
{ Private declarations }
procedure WMMYICONNOTIFY(var msg: TMessage); message WM_MYICONNOTIFY;
procedure WMSYSCOMMAND(var msg: TMessage); message WM_SYSCOMMAND;
procedure RestoreMainForm;
procedure HideMainForm;
procedure CreateTrayIcon;
procedure DeleteTrayIcon;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.CreateTrayIcon;
var
nidata: TNotifyIconData;
begin
with nidata do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := Self.Handle;
uID := 1;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
uCallBackMessage := WM_MYICONNOTIFY;
hIcon := Application.Icon.Handle;
StrPCopy(szTip, 'ПИЛОТ-2009');
end;
Shell_NotifyIcon(NIM_ADD, @nidata);
end;
procedure TForm1.DeleteTrayIcon;
var
nidata: TNotifyIconData;
begin
with nidata do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := Self.Handle;
uID := 1;
end;
Shell_NotifyIcon(NIM_DELETE, @nidata);
end;
procedure TForm1.HideMainForm;
begin
Application.ShowMainForm := False;
ShowWindow(Application.Handle, SW_HIDE);
ShowWindow(Application.MainForm.Handle, SW_HIDE);
end;
procedure TForm1.RestoreMainForm;
begin
Application.ShowMainForm := True;
ShowWindow(Application.Handle, SW_RESTORE);
ShowWindow(Application.MainForm.Handle, SW_RESTORE);
end;
procedure TForm1.WMMYICONNOTIFY(var msg: TMessage);
var
P: TPoint;
begin
if (msg.LParam = WM_LBUTTONUP) or (msg.LParam = WM_RBUTTONUP) then
begin
GetCursorPos(p);
SetForegroundWindow(Application.MainForm.Handle);
PopupMenu1.Popup(P.X, P.Y);
end;
end;
procedure TForm1.WMSYSCOMMAND(var msg: TMessage);
begin
inherited;
if (Msg.WParam = SC_MINIMIZE) then Hide1Click(Self);
if (Msg.WParam = SC_RESTORE) then Restore1Click(Self);
end;
{ события формы }
procedure TForm1.FormCreate(Sender: TObject);
begin
CreateTrayIcon();
Application.OnMinimize := Hide1Click;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteTrayIcon();
end;
{ Обработчики команд контекстного меню }
procedure TForm1.Hide1Click(Sender: TObject);
begin
HideMainForm();
CreateTrayIcon();
end;
procedure TForm1.Restore1Click(Sender: TObject);
begin
RestoreMainForm();
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;
end.
А это форма (файл dfm), которую я использовала:
Код:
object Form1: TForm1
Left = 192
Top = 114
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object PopupMenu1: TPopupMenu
Left = 16
Top = 64
object Hide1: TMenuItem
Caption = 'Hide'
OnClick = Hide1Click
end
object Restore1: TMenuItem
Caption = 'Restore'
OnClick = Restore1Click
end
object Exit1: TMenuItem
Caption = 'Exit'
OnClick = Exit1Click
end
end
end
P.S. Добавила еще строчку (Application.OnMinimize := Hide1Click), чтобы окно сворачивалось в трей при щелчке на кнопке в панели задач.
|