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

Delphi , Рабочий стол , TaskBar

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

(*
   (Vorbemerkung zu "TNA": damit ist der "Task Notification Area" gemeint.)

   Ein Symbol im TNA zu erzeugen -> kein Problem
   Ein Popupmenu beim Klick auf dieses Symbol anzuzeigen -> kein Problem
   AAABER dieses auch wieder verschwinden zu lassen wenn der Klick irgendwo anders
   erfolgt -> eine Katastrophe ... jedenfalls bis mir die Idee kam ... siehe unten
   die mit "ACHTUNG!!!" gekennzeichnete Zeile
 *)


 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.

Статья Показать контекстное меню на панели задач раздела Рабочий стол TaskBar может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: TaskBar ::