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

Материал из DRKB

Показать контекстное меню на панели задач[править | править код]

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