Форум: "Основная";
Текущий архив: 2002.02.04;
Скачать: [xml.tar.bz2];

Вниз

RxLib TrayIcon: как убрать из Taskbar   Найти похожие ветки 

← →
Fellomena   (2002-01-18 13:51) [2]

Все помешались на компонентах, которые иконку в Tray-е рассполагают 8(
Делайте сами - тогда всё можно будет изменить в любом месте:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure NotifyIcon(var Msg : TMessage);message WM_USER + 100;
procedure OnMinimizeEvt(Sender : TObject);
procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
public
{ Public declarations }
end;

var
Form1: TForm1;
MyMenu1: HMENU;
TrayIcon : TNotifyIconData;

implementation

{$R *.dfm}

procedure TForm1.OnMinimizeEvt(Sender : TObject);
begin
ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TForm1.NotifyIcon(var Msg : TMessage);
begin
case Msg.LParam of
WM_LBUTTONDBLCLK :
begin
ShowWindow(Application.Handle,SW_SHOW);
Application.Restore;
end;
WM_RBUTTONDOWN:
begin
Button2.Click;
TrackPopupMenu(MyMenu1, TPM_RIGHTBUTTON, Mouse.CursorPos.X, Mouse.CursorPos.Y, 0, Form1.Handle, 0);
end;
end;{case}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TrayIcon.cbSize := SizeOf(TrayIcon);
TrayIcon.Wnd := Form1.Handle;
TrayIcon.uID := 100;
TrayIcon.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
TrayIcon.uCallbackMessage := WM_USER + 100;
TrayIcon.hIcon := Application.Icon.Handle;
TrayIcon.szTip:="Fucking turget to destroy";
Shell_NotifyIcon(NIM_ADD,@TrayIcon);
Application.OnMinimize:= OnMinimizeEvt;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
MyMENUITEMINFO: tagMENUITEMINFO;
begin
with MyMENUITEMINFO do
begin
cbSize:=SizeOf(MENUITEMINFO);
fMask:=MIIM_ID+MIIM_TYPE;
fType:=MFT_STRING;
fState:=MFS_ENABLED;
wID:=1;
hSubMenu:=0;
hbmpChecked:=0;
hbmpUnchecked:=0;
dwItemData:=0;
dwTypeData:="Exit";
end;

MyMenu1:=CreatePopupMenu();
InsertMenuItem(MyMenu1, 0, false, MyMENUITEMINFO);
with MyMENUITEMINFO do
begin
cbSize:=SizeOf(MENUITEMINFO);
fMask:=MIIM_ID+MIIM_TYPE;
fType:=MFT_STRING;
fState:=MFS_ENABLED;
wID:=2;
hSubMenu:=0;
hbmpChecked:=0;
hbmpUnchecked:=0;
dwItemData:=0;
dwTypeData:="ShowMessage";
end;
InsertMenuItem(MyMenu1, 0, false, MyMENUITEMINFO);

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbRight then
TrackPopupMenu(MyMenu1, TPM_RIGHTBUTTON, Mouse.CursorPos.X, Mouse.CursorPos.Y, 0, Form1.Handle, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppMessage;
end;

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin

if (Msg.message = WM_COMMAND) and (LOWORD(Msg.wParam) = LOWORD(2)) then
begin
ShowMessage("Message recieved");
Handled := True;
end;
if (Msg.message = WM_COMMAND) and (LOWORD(Msg.wParam) = LOWORD(1)) then
begin
Shell_NotifyIcon(NIM_DELETE,@TrayIcon);
Close;
Handled := True;
end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon(NIM_DELETE,@TrayIcon); // ТУТ ТЫ ЕЁ УДАЛЯЕШЬ
end;

end.

Пример самопальный, но работает нормально вроде 8)

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.02.04;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.006 c