Показать сообщение отдельно
  #2  
Старый 21.04.2009, 09:15
Nyctos Kasignete Nyctos Kasignete вне форума
Активный
 
Регистрация: 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), чтобы окно сворачивалось в трей при щелчке на кнопке в панели задач.
Ответить с цитированием