Здравствуйте. Сегодня поговорим о том, как в Delphi создать TrayIcon - иконку справа на TaskBar, которая позволяет программе почти не занимать места на экране и при этом быть всегда легко доступной.

Для работы с TrayIcon используют функцию Shell_NotifyIcon, в которую передается одна из следующих команд: NIM_ADD, NIM_MODIFY или NIM_DELETE - создание, изменение и удаление иконки соответственно. Для обработки событий нужно создать процедуру, которая бы запускалась операционной системой.

Для создания у иконки всплывающего меню нужно создать PopupMenu и при нажатии на правую кнопку заставлять его всплывать.

...
  private
    procedure WMTRAYICONNOTIFY(var Msg: TMessage);
      message WM_NOTIFYTRAYICON;
    procedure DoPopup(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses ShellAPI, Menus;

var
  Popup: TPopupMenu;
  miOpen, miClose: TMenuItem;

procedure TForm1.WMTRAYICONNOTIFY(var Msg: TMessage);
var
  s: String;
  p: TPoint;
begin
  case msg.LParam of
    WM_MOUSEMOVE: s := 'Мышь сдвинута';
    WM_LBUTTONDOWN: s := 'Левая кнопка нажата';
    WM_LBUTTONUP: s := 'Левая кнопка отпущена';
    WM_LBUTTONDBLCLK: begin
      s := 'Два раза нажата левая кнопка';
      DoPopup(miOpen);
    end;
    WM_RBUTTONDOWN: s := 'Правая кнопка нажата';
    WM_RBUTTONUP: begin
      s := 'Правая кнопка отпущена';
      SetForegroundWindow(Form1.Handle);
      GetCursorPos(p);
      Popup.Popup(p.x, p.y);
      PostMessage(Form1.Handle, WM_NULL, 0, 0);
    end;
    WM_RBUTTONDBLCLK: s := 'Два раза нажата правая кнопка';
    else s := IntToStr(msg.LParam);
  end;
  ListBox1.Items.Add(s);
  ListBox1.ItemIndex := ListBox1.Items.Count - 1;
end;

procedure TForm1.DoPopup(Sender: TObject);
begin
  if Sender = miClose then Form1.Close else begin
    ShowWindow(Form1.Handle, SW_SHOWNORMAL);
    SetForegroundWindow(Form1.Handle);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  tray: TNotifyIconData;
  Ic: TIcon;
begin
  Ic := TIcon.Create;
  Ic.LoadFromFile('Icon1.ico');
  with tray do begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := Form1.Handle;
    uID := 1;
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    uCallBackMessage := WM_NOTIFYTRAYICON;
    hIcon := Ic.Handle;
    szTip := ('Это наша иконка');
  end;
  Shell_NotifyIcon(NIM_ADD, Addr(tray));
  Ic.Destroy;

  Popup := TPopupMenu.Create(nil);
  miOpen := TMenuItem.Create(nil);
  miOpen.Caption := 'Open';
  miOpen.Default := true;
  miOpen.OnClick := DoPopup;
  Popup.Items.Add(miOpen);
  miClose := TMenuItem.Create(nil);
  miClose.Caption := 'Close';
  miClose.OnClick := DoPopup;
  Popup.Items.Add(miClose);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  tray: TNotifyIconData;
  Ic: TIcon;
begin
  Ic := TIcon.Create;
  Ic.LoadFromFile('Icon2.ico');
  with tray do begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := Form1.Handle;
    uID := 1;
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    uCallBackMessage := WM_NOTIFYTRAYICON;
    hIcon := Ic.Handle;
    szTip := ('Это другая иконка');
  end;
  Shell_NotifyIcon(NIM_MODIFY, Addr(tray));
  Ic.Destroy;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  tray: TNotifyIconData;
begin
  with tray do begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := Form1.Handle;
    uID := 1;
  end;
  Shell_NotifyIcon(NIM_DELETE, Addr(tray));
end;

На сайте http://delphi4all.narod.ru/ Вы найдете еще более 100 советов по Delphi.
Email: delphi4all@narod.ru

Тематические ссылки

Ваша ссылка

Ваша ссылка

Обмен кнопками, ведение статистики, реклама.