Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Иконка на TrayBar - пример


unit shellUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus;

const
  WM_MYICONNOTIFY = WM_USER + 123;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    RestoreItem: TMenuItem;
    N1: TMenuItem;
    FileExitItem1: TMenuItem;
    HideItem: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RestoreItemClick(Sender: TObject);
    procedure HideItemClick(Sender: TObject);
    procedure FileExitItem1Click(Sender: TObject);
  private
    { Private declarations }
    ShownOnce: Boolean;
  public
    { Public declarations }
    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;

var
  Form1: TForm1;

implementation

{$R *.DFM}
uses ShellApi, shlobj, registry;

procedure TForm1.WMICON(var msg: TMessage);
var
  P: TPoint;
begin
  case msg.LParam of // обработка обратных сообщений
    WM_LBUTTONUP: //по нажатию левой клавиши, WM_RBUTTONUP по правой
      begin
        GetCursorPos(p);
        SetForegroundWindow(Application.MainForm.Handle);
        PopupMenu1.Popup(P.X, P.Y);
      end;
    WM_LBUTTONDBLCLK: RestoreItemClick(Self); //как Default
  end;
end;

procedure TForm1.WMSYSCOMMAND(var msg: TMessage);
begin
  inherited; //обработка минимизирвания окна, не сворачевается а скрывается
  if (Msg.wParam = SC_MINIMIZE) then
    HideItemClick(Self);
end;

procedure TForm1.HideMainForm;
begin
  //при сокрытии окна
  Application.ShowMainForm := False;
  ShowWindow(Application.Handle, SW_HIDE);
  ShowWindow(Application.MainForm.Handle, SW_HIDE);
end;

procedure TForm1.RestoreMainForm;
var
  i, j: Integer;
begin
  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
  with nidata do
  begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := Self.Handle; //HWND вашего окна (окна принимающего обратные сообщения)
    uID := 1; // номер значка
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; //обрабатываемые флаги
    uCallBackMessage := WM_MYICONNOTIFY;
    hIcon := Application.Icon.Handle;
      // то откуда сдергивается значек это может быть и ImageList и т.д.
    StrPCopy(szTip, Application.Title);
      // всплывающая строка, может быть любой string главное с нулевым окончанием
  end;
  Shell_NotifyIcon(NIM_ADD, @nidata); // добавление значка
end;

procedure TForm1.DeleteTrayIcon(n: Integer);
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.FormCreate(Sender: TObject);
begin
  ShownOnce := False;
  CreateTrayIcon(1);
  HideItem.Enabled := False;
end;

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

procedure TForm1.RestoreItemClick(Sender: TObject);
begin
  RestoreMainForm;
  //если убрать ремарку то при показывании основного окна значек исчезает
  //DeleteTrayIcon(1);
  RestoreItem.Enabled := False;
  HideItem.Enabled := True;
end;

procedure TForm1.HideItemClick(Sender: TObject);
begin
  HideMainForm;
  CreateTrayIcon(1);
  HideItem.Enabled := False;
  RestoreItem.Enabled := True;
end;

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

end.

{Также есть еще такая фигня Shell_NotifyIcon(NIM_Modify, @nidata) позволяет
менять уже установленный значек, не прибегая к его убиванию и построению заново}

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.