Последние записи

made in programmersforum 8

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

1st
Май

Добавить в трей программу, без сторонних компонентов

Posted by Chas under Delphi

Учусь добавлять программу в трей, без использования компонентов сторонних.



unit Unit1;
interface
uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Menus, ShellApi;
const

WM_NOTIFYTRAYICON = WM_USER + 1;
type

  TForm1 = class(TForm)

    pm: TPopupMenu;

    Collapse1: TMenuItem;

    Close1: TMenuItem;

    procedure FormDestroy(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure Close1Click(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

    procedure Collapse1Click(Sender: TObject);

  private

    procedure WMTRAYICONNOTIFY(var Msg: TMessage); message WM_NOTIFYTRAYICON;

  public

    { Public declarations }

  end;
var

  Form1: TForm1;

  Tray: TNotifyIconData;

  TrayIcon: TIcon;

  AppClose:Boolean=False;
implementation
{$R *.dfm}
procedure CollapseUnwrapToTray;

begin

  Form1.Visible:=not Form1.Visible;

  if Form1.Visible=True then Application.BringToFront;

end;
procedure TForm1.WMTRAYICONNOTIFY(var Msg: TMessage);

var p:TPoint;

begin

  case Msg.LParam of

    WM_LBUTTONUP:CollapseUnwrapToTray;

    WM_RBUTTONUP:

    begin

      GetCursorPos(p);

      SetForegroundWindow(Form1.Handle);

      pm.Popup(P.X, P.Y);

    end;

  end;

end;
procedure TForm1.FormDestroy(Sender: TObject);

begin

  try

  with tray do

  begin

    cbSize := TNotifyIconData.SizeOf;

    Wnd := Form1.Handle;

    uID := 1;

  end;

  Shell_NotifyIcon(NIM_DELETE, Addr(tray));

  finally

  Application.Terminate;

  end;

end;
procedure TForm1.FormCreate(Sender: TObject);

begin

  TrayIcon := Application.Icon;

  with tray do

  begin

    cbSize := TNotifyIconData.SizeOf;

    Wnd := Form1.Handle;

    uID := 1;

    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;

    uCallBackMessage := WM_NOTIFYTRAYICON;

    hIcon := TrayIcon.Handle;

    szTip := '3D Hunter';

  end;

  Shell_NotifyIcon(NIM_ADD, Addr(tray));

end;
procedure TForm1.Close1Click(Sender: TObject);

begin

  AppClose:=True;

  Form1.Close;

end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

  CanClose:=AppClose;

  if AppClose=False then CollapseUnwrapToTray;

end;
procedure TForm1.Collapse1Click(Sender: TObject);

begin

  CollapseUnwrapToTray;

end;
end.