Balloon Tips
Привет всем!
Подскажите, как реализовать такую штуку:
Программа "сидит" в системном трее,
при определенном событии необходимо показать Balloon Tips
Заранее благодарю!
Подскажите, как реализовать такую штуку:
Программа "сидит" в системном трее,
при определенном событии необходимо показать Balloon Tips
Заранее благодарю!
[QUOTE]Originally posted by GooD
Привет всем!
Подскажите, как реализовать такую штуку:
Программа "сидит" в системном трее,
при определенном событии необходимо показать Balloon Tips
Под Win9x - никак из-за невозможности определить координаты в трее, под >=Win2k - следующим образом:
unit Unit1;
interface
uses ...
ShellApi;
const
NIF_INFO = $00000010;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
TRAY_CALLBACK_MSG = WM_USER + $1958;
type
TNotifyIconDataEx = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of AnsiChar; // Previously 64 chars, now 128
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
uTimeout: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
{$IFDEF _WIN32_IE_600}
guidItem: TGUID; // Reserved for XP
{$ENDIF}
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
IconData: TNotifyIconDataEx;
procedure TrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK_MSG;
function CreateIcon: boolean;
function ShowBaloonHint(Title: string; Text: string; IconType: DWORD; TOutMS: UINT): boolean;
public
{ Public declarations }
end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.TrayIconMsgHandler(var Msg: TMessage);
begin
case Msg.lParam of
WM_MOUSEMOVE:; WM_LBUTTONDOWN:; WM_LBUTTONUP:; WM_LBUTTONDBLCLK: close;
WM_RBUTTONDOWN:; WM_RBUTTONUP:; WM_RBUTTONDBLCLK:;
end
end;
function TForm1.CreateIcon: boolean;
begin
Result := False;
with IconData do
begin
cbSize := SizeOf(IconData);
Wnd := Classes.AllocateHWnd(TrayIconMsgHandler);
uID := 0;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
uCallbackMessage := TRAY_CALLBACK_MSG; //user defined callback message
hIcon := Application.Icon.Handle; //an Icon's Handle
szTip := 'My tray icon';
if Shell_NotifyIcon(NIM_ADD, @IconData) then Result := True
else
ShowMessage('Thank''s to Billy')
end
end;
function TForm1.ShowBaloonHint(Title: string; Text: string;
IconType: DWORD; TOutMS: UINT): boolean;
begin
with IconData do
begin
cbSize := SizeOf(IconData);
uFlags := uFlags or NIF_INFO;
StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
uTimeout := TOutMS;
dwInfoFlags := IconType //0, NIIF_INFO..NIIF_ERROR
end;
Result := Shell_NotifyIcon(NIM_MODIFY, @IconData)
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowBaloonHint('Information', 'Button1 was clicked', NIIF_INFO, 3000)
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FillChar(IconData, SizeOf(IconData), #0);
if not CreateIcon then Application.Terminate
end;
END.
Привет всем!
Подскажите, как реализовать такую штуку:
Программа "сидит" в системном трее,
при определенном событии необходимо показать Balloon Tips
Под Win9x - никак из-за невозможности определить координаты в трее, под >=Win2k - следующим образом:
unit Unit1;
interface
uses ...
ShellApi;
const
NIF_INFO = $00000010;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
TRAY_CALLBACK_MSG = WM_USER + $1958;
type
TNotifyIconDataEx = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of AnsiChar; // Previously 64 chars, now 128
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
uTimeout: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
{$IFDEF _WIN32_IE_600}
guidItem: TGUID; // Reserved for XP
{$ENDIF}
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
IconData: TNotifyIconDataEx;
procedure TrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK_MSG;
function CreateIcon: boolean;
function ShowBaloonHint(Title: string; Text: string; IconType: DWORD; TOutMS: UINT): boolean;
public
{ Public declarations }
end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.TrayIconMsgHandler(var Msg: TMessage);
begin
case Msg.lParam of
WM_MOUSEMOVE:; WM_LBUTTONDOWN:; WM_LBUTTONUP:; WM_LBUTTONDBLCLK: close;
WM_RBUTTONDOWN:; WM_RBUTTONUP:; WM_RBUTTONDBLCLK:;
end
end;
function TForm1.CreateIcon: boolean;
begin
Result := False;
with IconData do
begin
cbSize := SizeOf(IconData);
Wnd := Classes.AllocateHWnd(TrayIconMsgHandler);
uID := 0;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
uCallbackMessage := TRAY_CALLBACK_MSG; //user defined callback message
hIcon := Application.Icon.Handle; //an Icon's Handle
szTip := 'My tray icon';
if Shell_NotifyIcon(NIM_ADD, @IconData) then Result := True
else
ShowMessage('Thank''s to Billy')
end
end;
function TForm1.ShowBaloonHint(Title: string; Text: string;
IconType: DWORD; TOutMS: UINT): boolean;
begin
with IconData do
begin
cbSize := SizeOf(IconData);
uFlags := uFlags or NIF_INFO;
StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
uTimeout := TOutMS;
dwInfoFlags := IconType //0, NIIF_INFO..NIIF_ERROR
end;
Result := Shell_NotifyIcon(NIM_MODIFY, @IconData)
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowBaloonHint('Information', 'Button1 was clicked', NIIF_INFO, 3000)
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FillChar(IconData, SizeOf(IconData), #0);
if not CreateIcon then Application.Terminate
end;
END.