unit TNA;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls,
ShellApi, Menus;
const
k_WM_TASKMSG = WM_APP + 100; //die "100" ist ein frei wählbarer Wert
type
TForm1 = class(TForm)
TPopupMenu1: TPopupMenu;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDblClick(Sender: TObject);
procedure PopupMenuClick(Sender: TObject);
private
{ Private-Deklarationen }
tTNA: TNotifyIconData;
procedure WMTaskMsg(var Msg: TMessage); message k_WM_TASKMSG;
procedure AppActive;
procedure AppDeactivate;
procedure ShowIcon;
procedure ChangeIcon;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{$R
TNA.RES} //eine Resource mit 2 Icons oder Bitmaps
procedure TForm1.FormCreate(Sender: TObject);
begin
{läßt die Form schon bei Programmstart verschwinden}
Application.ShowMainForm := False;
{Symbol im
TNA anzeigen}
Self.ShowIcon;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{Symbol aus dem
TNA entfernen}
Shell_NotifyIcon(NIM_DELETE, @tTNA);
end;
procedure TForm1.FormDblClick(Sender: TObject);
begin
{lassen wir doch die Form wieder verschwinden ...}
Self.AppDeactivate;
{... und ändern das Symbol in dem
TNA}
Self.ChangeIcon;
end;
procedure TForm1.PopupMenuClick(Sender: TObject);
begin
case TPopupMenu(Sender).Tag of
{hier steht dann die Auswahl was getan werden soll}
{wenn auf das erschienene Popupmenü geklickt wurde}
end;
end;
procedure TForm1.WMTaskMsg(var Msg: TMessage);
var
rCursor: TPoint;
begin
{wenn die Nachricht aus unserem definierten Bereich kommt dann ...}
if Msg.wParam = tTNA.uID then
begin
{... tu was wenn das Ereignis ein ...}
case Msg.lParam of
{... rechter Mausklick ist oder ...}
WM_RBUTTONDOWN:
begin
{aktuelle Cursoposition holen}
GetCursorPos(rCursor);
{ACHTUNG!!!!! Der folgende Aufruf ist an dieser Stelle ganz wichtig!!!!}
{Erst durch diese
API-Funktion wird das Popupmenü dazu bewegt zu verschwinden
wenn ein Klick außerhalb des Popupmenüs erfolgt}
SetForegroundWindow(Self.Handle);
{Also, nicht vergessen!!!}
{Das Popupmenü erscheint an der gewünschten Position in dem
TNA}
TPopupMenu1.Popup(rCursor.x, rCursor.y);
end;
{... ein linker doppelter Mausklick ist}
WM_LBUTTONDBLCLK: Self.AppActive;
end;
end;
end;
procedure TForm1.AppActive;
var
hOwner: THandle;
begin
{Form einblenden}
SendMessage(Self.Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
ShowWindow(Self.Handle, SW_SHOW);
SetForegroundWindow(Self.Handle);
{Symbol in der Taskbar einblenden}
hOwner := GetWindow(Self.Handle, GW_OWNER);
SendMessage(hOwner, WM_SYSCOMMAND, SC_RESTORE, 0);
ShowWindow(hOwner, SW_SHOW);
end;
procedure TForm1.AppDeactivate;
begin
{Form ausblenden}
ShowWindow(Self.Handle, SW_HIDE);
{Symbol in der Taskbar ausblenden}
ShowWindow(GetWindow(Self.Handle, GW_OWNER), SW_HIDE);
end;
procedure TForm1.ShowIcon;
begin
tTNA.cbSize := SizeOf(tTNA);
tTNA.Wnd := Self.Handle;
tTNA.uID := 24112000; //frei wählbarer Wert zur Identifizierung
tTNA.uCallbackMessage := k_WM_TASKMSG;
tTNA.hIcon := LoadIcon(hInstance, 'xxx');
//xxx ist die Bezeichnung eines Icons aus "
TNA.res"
StrCopy(tTNA.szTip, 'Hallo'); //Hint
tTNA.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
{CB Symbol in dem
TNA einrichten CE}
Shell_NotifyIcon(NIM_ADD, @tTNA);
end;
procedure TForm1.ChangeIcon;
begin
tTNA.cbSize := SizeOf(tTNA);
tTNA.hIcon := LoadIcon(hInstance, 'yyy');
//yyy ist die Bezeichnung eines weiteren Icons aus "
TNA.res"
StrCopy(tTNA.szTip, 'Welt'); //Hint
{CB Symbol im
TNA ändern CE}
Shell_NotifyIcon(NIM_MODIFY, @tTNA);
end;
end.