(* *****************************************************************************
Datum der Erstellung := 07-06-2005
Datum der letzten Änderung := 07-06-2005
Unit mit Methoden um ein Icon in der Trayleiste zu plazieren und
auf dessen Ereignisse zu achten.
***************************************************************************** *)
unit uSystray;
interface
uses ShellApi, Windows, Messages, Forms, Menus, Classes, StdCtrls;
Type
TSystrayIcon =
Class
FHandle: Cardinal;
FOldWndProc: TWndMethod;
FTaskbarEvent: Cardinal;
FTaskbarCreated: Cardinal;
FTrayicon: TNotifyIconData;
FTrayDescription:
String;
FPopupMenu: TPopupMenu;
Constructor newCreate(IconHint:
String);
Destructor newDestroy;
private
Procedure MessageHandler(
Var Msg: TMessage);
Procedure AddIconToSystray(Description:
String);
Procedure RemoveIconFromSystray;
end;
implementation
(* *****************************************************************************
Datum der Erstellung := 07-06-2005
Datum der letzten Änderung := 07-06-2005
Erzeugt ein Objekt der Klasse und erstellt das Icon im Systray,
falls der Explorer abstürzt wird das Icon beim Start wieder hergestellt.
***************************************************************************** *)
Constructor TSystrayIcon.newCreate(IconHint:
String);
Begin
Inherited Create;
FHandle := AllocateHWnd(MessageHandler);
FTaskbarEvent := RegisterWindowMessage('
SystrayCallback');
FTaskbarCreated := RegisterWindowMessage('
TaskbarCreated');
FTrayDescription := IconHint;
AddIconToSystray(FTrayDescription);
End;
(* *****************************************************************************
Datum der Erstellung := 07-06-2005
Datum der letzten Änderung := 07-06-2005
Zerstört das Objekt und entfernt das Icon aus dem Systray
***************************************************************************** *)
Destructor TSystrayIcon.newDestroy;
Begin
DeallocateHWnd(FHandle);
RemoveIconFromSystray;
Inherited Destroy;
End;
(* *****************************************************************************
Datum der Erstellung := 07-06-2005
Datum der letzten Änderung := 07-06-2005
Reagiert auf Mausklicks auf das Trayicon und zeigt ein
Menü an bei Rechtsklick
***************************************************************************** *)
Procedure TSystrayIcon.MessageHandler(
Var Msg: TMessage);
Var
ptCursor: Tpoint;
Begin
if Msg.Msg = FTaskbarEvent
then
begin
If Msg.LParam = WM_RBUTTONDOWN
then
begin
GetCursorPos(ptCursor);
if Assigned(FPopupMenu)
then
FPopupMenu.Popup(ptCursor.X, ptCursor.Y);
end
else If Msg.LParam = WM_LBUTTONDOWN
then
begin
MessageBox(Application.Handle, '
Test', '
test', MB_OK)
end;
end
else if Msg.Msg = FTaskbarCreated
then
begin
AddIconToSysTray(FTrayDescription);
end;
End;
(* *****************************************************************************
Datum der Erstellung := 07-06-2005
Datum der letzten Änderung := 07-06-2005
Fügt dem Systray ein neues Icon hinzu das auf Mausklicks reagiert um
ein Menü anzuzeigen.
***************************************************************************** *)
Procedure TSystrayIcon.AddIconToSystray(Description:
String);
begin
Fillchar(FTrayicon.szTip, SizeOf(FTrayicon.szTip), 0);
Move(Description[1], FTrayicon.szTip, Length(Description));
FTrayicon.cbSize := SizeOf(FTrayicon);
FTrayicon.Wnd := FHandle;
FTrayicon.uFlags := NIF_ICON
or NIF_TIP
or NIF_MESSAGE;
FTrayicon.hIcon := Application.Icon.Handle;
FTrayicon.uCallbackMessage := FTaskbarEvent;
FTrayicon.uID := 27787552;
Shell_NotifyIcon(NIM_DELETE, @FTrayicon);
Shell_NotifyIcon(NIM_ADD, @FTrayicon);
end;
(* *****************************************************************************
Datum der Erstellung := 07-06-2005
Datum der letzten Änderung := 07-06-2005
Entfernt das Trayicon aus dem Systray.
***************************************************************************** *)
Procedure TSystrayIcon.RemoveIconFromSystray;
Begin
Shell_NotifyIcon(NIM_DELETE, @FTrayicon);
End;
end.