Иконка у часов

[Lonix]

Как сделать так чтобы была иконка у часов, а на неё нажимаешь и выводится меню программы?


Заранее спасибо!

[merax]

Сообщение от Lonix

Как сделать так чтобы была иконка у часов, а на неё нажимаешь и выводится меню программы?


Заранее спасибо!

Компонент CoolTrayIcon + popupmenu.

Да кстати документацию по работе с компонентом не забудь прочесть!

[Voland]

Если не хочешь компонент - читай Win32 SDK по теме Shell_NotifyIcon

[Квэнди]

Delphi 8 и старше.
TTrarIcon.
В стандартной палитре компонент.

[dron-s]

вот такой кодик...
писал для себя когда писал на WinAPI

const
 WM_MYICONNOTIFY = WM_USER + 123;
    
    procedure RestoreItemClick(Sender: TObject);
    procedure HideItemClick(Sender: TObject);
    procedure FileExitItem1Click(Sender: TObject);
  private
  ShownOnce: Boolean;
  public
    procedure WMICON(var msg: TMessage); message WM_MYICONNOTIFY;
    procedure WMSYSCOMMAND(var msg: TMessage);message WM_SYSCOMMAND;
    procedure RestoreMainForm;
    procedure HideMainForm;
    procedure CreateTrayIcon(n:Integer);
    procedure DeleteTrayIcon(n:Integer);
  end;

uses ComObj,  Activex, ShellApi, Shlobj, Registry;

{Если CheckBox1.Checked=true то программа будет сворачиваться в SystemTray а если false То нет}

procedure TForm1.WMICON(var msg: TMessage);
var Pos : TPoint;
begin
if CheckBox1.Checked=false then Exit;
 case msg.LParam of
 WM_RBUTTONDOWN:
  begin
   GetCursorPos(Pos);
   SetForegroundWindow(Application.MainForm.Handle);
   PopupMenu1.Popup(Pos.X, Pos.Y);
  end;
 WM_LBUTTONDBLCLK :RestoreItemClick(Self);
 end;
end;

procedure TForm1.WMSYSCOMMAND(var msg: TMessage);
begin
 inherited;
 if (Msg.wParam=SC_MINIMIZE) then HideItemClick(Self);
end;


procedure TForm1.HideMainForm;
begin
if CheckBox1.Checked=false then Exit;
  Application.ShowMainForm := False;
  ShowWindow(Application.Handle, SW_HIDE);
  ShowWindow(Application.MainForm.Handle, SW_HIDE);
end;

procedure TForm1.RestoreMainForm;
var i,j : Integer;
begin
if CheckBox1.Checked=false then Exit;
  Application.ShowMainForm := True;
  ShowWindow(Application.Handle, SW_RESTORE);
  ShowWindow(Application.MainForm.Handle, SW_RESTORE);
  if not ShownOnce then
  begin
    for I := 0 to Application.MainForm.ComponentCount -1 do
      if Application.MainForm.Components[I] is TWinControl then
        with Application.MainForm.Components[I] as TWinControl do
          if Visible then
          begin
            ShowWindow(Handle, SW_SHOWDEFAULT);
            for J := 0 to ComponentCount -1 do
              if Components[J] is TWinControl then
                ShowWindow((Components[J] as TWinControl).Handle, SW_SHOWDEFAULT);
          end;
    ShownOnce := True;
  end;
end;

procedure TForm1.CreateTrayIcon(n:Integer);
var nidata : TNotifyIconData;
begin
if CheckBox1.Checked=false then Exit;
 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,’Название твое программы :)’);
  end;
  Shell_NotifyIcon(NIM_ADD, @nidata);
end;

procedure TForm1.DeleteTrayIcon(n:Integer);
var nidata : TNotifyIconData;
begin
if CheckBox1.Checked=false then Exit;
 with nidata do
  begin
   cbSize := SizeOf(TNotifyIconData);
   Wnd := Self.Handle;
   uID := 1;
  end;
  Shell_NotifyIcon(NIM_DELETE, @nidata);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ShownOnce:= False;
 CreateTrayIcon(1);
end;


procedure TForm1.RestoreItemClick(Sender: TObject);
begin
RestoreMainForm;
 DeleteTrayIcon(1);
end;

procedure TForm1.HideItemClick(Sender: TObject);
begin
HideMainForm;
 CreateTrayIcon(1);
end;

procedure TForm1.FileExitItem1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteTrayIcon(1);
end;

procedure TForm1.N1Click(Sender: TObject);
begin
 RestoreMainForm; //Восстановить
end;

procedure TForm1.N2Click(Sender: TObject);
begin
 HideItemClick(Self); //Свернуть
end;

Довольно таки нтересный пример... есть над чем поиграться и есть что дописать для полного счастья