Показать контекстное меню на панели задач

=== Показать контекстное меню на панели задач ===
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 wahlbarer 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
 { la?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 andern 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 Popupmenu 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 Popupmenu dazu bewegt zu verschwinden
 wenn ein Klick au?erhalb des Popupmenus erfolgt }
 SetForegroundWindow(Self.Handle);
 { Also, nicht vergessen!!! }
 { Das Popupmenu erscheint an der gewunschten 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 wahlbarer 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 andern CE}
 Shell_NotifyIcon(NIM_MODIFY, @tTNA);
end;
end.
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01791