Umíme to s Delphi: 73. díl – tray ikona, dokončení tvorby

Na úplný úvod si opět zrekapitulujeme, do jakého stavu jsme uvedli svou novou komponentu v minulém díle seriálu. Vyřešili jsme způsob, kterým přijímat a zpracovávat zprávy od ikony a vytvořili jsme za tím účelem jednoduchý pomocný objekt IconManager. Poté jsme promysleli všechny vlastnosti, které od komponenty požadujeme a implementovali jsme jejich zápisové metody. Kromě toho jsme si vysvětlili několik zajímavých problémů, například funkce ShowWindow.

Události komponenty TrayIkona

Podobně jako jsme se zabývali vlastnostmi, si musíme rozvážit také události, které naše komponenta hodlá poskytovat. Bude se jednat o jedinou událost OnClick, která vznikne vždy, když se na ikonu klepne myší.

Je nutné vzpomenout si, jak se v komponentě vytvářejí události. Opět odkazuji na díly týkající se vytváření komponent. Události jsou v podstatě vlastnostmi datového typu TNotifyEvent. Pro bližší informace odkazuji na díly 44 – 47 tohoto seriálu, kde naleznete podrobný popis tvorby komponent.

  private
    ...
    FOnClick: TNotifyEvent;    // privátní atribut pro událost OnClick
    ...
  published
    ...
    property OnClick: TNotifyEvent read FOnClick write FOnClick;  // událost
    ...

Nejtěžší úkol však spočívá v zajištění, aby událost OnClick byla vyvolána ve správné situaci, tedy při klepnutí myší na ikonu ve stavové oblasti. Za tím účelem se musíme vrátit v úvahách zpátky, konkrétně k objektu IconManager, který (jak jsme uvedli výše) má za úkol přijímat zprávy ze stavové oblasti a zpracovávat je. Už víme, že IconManager spravuje okno určené k odchytu zpráv a že všechen kód bude uveden v okenní proceduře tohoto okna. Můžeme si tedy konečně uvést implementaci této okenní procedury:

procedure TIconManager.TrayWndProc(var Message: TMessage);
var
  Pt: TPoint;
  TheIcon: TTrayIkona;
begin
  with Message do   
  begin
    if (Msg = DDGM_TRAYICON) then    // je-li zpráva ze stavové oblasti
    begin
      // v parametru Message.WParam je rozlišeno, jaká ikona je původcem zprávy
      TheIcon := TTrayIkona(WParam);
      // a v parametru lParam je identifikace zprávy
      case lParam of
        WM_LBUTTONDOWN:
          if (Assigned(TheIcon.FOnClick) then
            TheIcon.FOnClick(Self);
        WM_RBUTTONDOWN:
          begin
            if Assigned(TheIcon.FPopupMenu) then
            begin
              SetForegroundWindow(IconMgr.HWindow);
              GetCursorPos(Pt);
              TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
              PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
            end;
          end;
      end;
    end
    else
      Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
  end;
end;

Poznámky ke zdrojovému kódu:

• v těle metody nejprve otestujeme, zda se jedná o zprávu ze stavové oblasti hlavního panelu (zda se jedná o námi definovanou zprávy DDGM_TRAYICON)
• pokud ano, přiřadíme do pomocné lokální proměnné TheIcon ikonu, která je původcem zprávy. Tuto ikonu se dozvíme z parametru wParam zprávy, kterou jsme obdrželi
• v parametru lParam je pak specifikováno, o jakou zprávu se přesně jedná. Nás zajímají jen dvě zprávy: WM_LBUTTONDOWN a WM_RBUTTONDOWN
• pokud se jedná o klepnutí levým tlačítkem (WM_LBUTTONDOWN), vyvoláme událost OnClick, pokud ji uživatel komponenty ošetřil. Pokud ji neošetřil, nestane se po klepnutí levým tlačítkem vůbec nic
• pokud se jedná o klepnutí pravým tlačítkem (WM_RBUTTONDOWN), otestujeme, zda uživatel komponenty přiřadil nějakou rozbalovací nabídku do vlastnosti PopupMenu. Pokud ne, nestane se po klepnutí pravým tlačítkem nic. Pokud naopak ano, zavoláme nejprve funkci SetForegroundWindow. Tato funkce Windows API slouží k aktivaci okna a k jeho zobrazení v popředí plochy. Funkci předáme jako parametr handle našeho (fiktivního) okna objektu IconManager. Tento zdánlivě zbytečný krok, který v podstatě přesouvá do popředí neviditelné okno, je pro správnou funkčnost rozbalovací nabídky nezbytný. Dále zavoláme funkci GetCursorPos ro zjištění aktuální pozice kurzoru a následně rozbalíme nabídku specifikovanou ve vlastnosti Popup komponenty TrayIkona. Nakonec musíme provést další poněkud „umělý krok“ spočívající v odeslání zprávy oknu objektu IconManager. Důvodem je zajištění přepnutí úlohy.
• poslední operací v této okenní proceduře je předání jakékoliv jiné zprávy než DDGM_TRAYICON funkci DefWindowProc pro standardní zpracování

Co zbývá?

Dalo by se říci, že nejobtížnější činnosti máme úspěšně za sebou. Zbývá několik dalších maličkostí, kterými se nyní postupně probereme. První z nich je implementace konstruktoru a destruktoru komponenty TTrayIkona:

constructor TTrayIkona.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  LoadDefaultIcon;
end;

destructor TTrayIkona.Destroy;
begin
  if FIconVisible then SetIconVisible(False);   
  FIcon.Free;                                   
  inherited Destroy;
end;

Poznámky ke zdrojovému kódu:

• v konstruktoru nejprve zavoláme konstruktor předka (tedy třídy TComponent). Pak pouze vytvoříme objekt třídy TIcon, abychom mohli pracovat s privátním atributem FIcon, a zavoláme metodu LoadDefaultIcon. Tuto metodu vytvoříme níže a bude sloužit k načtení standardní ikony (obrázku letícího okénka) v případě, že uživatel komponenty nespecifikoval jinou ikonu ve vlastnosti Icon
• destruktor je „zrcadlově obráceným“ konstruktorem: nejprve zrušíme ikonu a posléze zavoláme destruktor předka

Budeme také potřebovat metodu, která dokáže vrátit handle aktivní ikony:

function TTrayIkona.ActiveIconHandle: THandle;
begin
  if (FIcon.Handle <> 0) then
    Result := FIcon.Handle
  else
    Result := FDefaultIcon;
end;

Poznámky ke zdrojovému kódu:

• kód je zde mimořádné jednoduchý – pokud existuje ikona ve vlastnosti Icon, je vrácen její handle. V opačném případě je vrácena hodnota atributu FDefaultIcon, což je (připomeňme) handle default ikony.

Další metoda bude pracovat s privátním atributem FDefaultIcon. Pokud uživatel nezvolí jinou ikonu, dojde pomocí této metody k nahrání standardní ikony (ikona jakéhosi okénka). Využijeme přitom funkce LoadIcon:

function LoadIcon(hInstance: HINSTANCE, lpIconName: LPCTSTR): HICON;

Prvním parametrem této funkce je handle modulu, z něhož ikonu nahráváme. Pro nahrání standardní ikony se používá hodnota 0. Druhý parametr je název resource s ikonou (systémovými zdroji – resources – se budeme zabývat v některém z příštích dílů seriálu). Pro standardní ikony můžeme použít některou z předdefinovaných konstant:

Konstanta	Označuje ikonu
IDI_APPLICATION	Přednastavená ikona aplikace
IDI_ASTERISK	Hvězdička
IDI_EXCLAMATION	Vykřičník
IDI_HAND	Prst
IDI_QUESTION	Otazník
IDI_WINLOGO	Logo Windows

procedure TTrayIkona.LoadDefaultIcon;
begin
  FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;

Další záležitost, na níž jsme prozatím nepomysleli, se týká samotného startu aplikace. Dosud jsme nezajistili, aby se po spuštění aplikace ikona zobrazila ve stavové části. Proto musíme využít některou metodu, která je volána bezprostředně po spuštění aplikace. Diskuse o vhodném umístění takového programového kódu je uvedena v 44. dílu tohoto seriálu. Na základě výsledků této diskuse si zvolíme např. metodu Loaded:

procedure TTrayIkona.Loaded;
begin
  inherited Loaded;
  if FIconVisible then
    SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;

Poznámky ke zdrojovému kódu:

• nejprve zajistíme zavolání metody Loaded předka
• pak otestujeme, zda má být ikona viditelná (zobrazena) a pokud ano, zavoláme metodu SendTrayMessage s parametrem NIM_ADD pro zobrazení ikony. Připomeňme, že metoda SendTrayMessage (kterou jsme vytvořili v 71. dílu seriálu) zapouzdřuje volání funkce Windows API Shell_NotifyIcon.

Pomocí metody Notification zajistíme, aby se v případě odebrání rozbalovací nabídky (Popup Menu) odstranil příslušný odkaz:

procedure TTrayIkona.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = PopupMenu) then
    PopupMenu := nil;
end;

Hotovo!

A to je vlastně všechno. Právě jsme dokončili jeden z nejobtížnějších úkolů v historii našeho seriálu. Slibuji, že příště se budeme zabývat opět něčím pochopitelnějším. Nyní si uvedeme kompletní zdrojový kód, který by měl být výsledkem našeho snažení. Pro úsporu místa jej opět uvedeme bez vysvětlujících komentářů, pro podrobný popis jeho jednotlivých fragmentů doporučuji prostudovat dnešní díl seriálu a dva předchozí díly.

unit TrayIcon;

interface

uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus, StdCtrls, ExtCtrls;

type
  TTrayIkona = class(TComponent)
  private
    FDefaultIcon: THandle;
    FIcon: TIcon;
    FHideTask: Boolean;
    FHint: string;
    FIconVisible: Boolean;
    FPopupMenu: TPopupMenu;
    FOnClick: TNotifyEvent;
    Tnd: TNotifyIconData;
    procedure SetIcon(Value: TIcon);
    procedure SetHideTask(Value: Boolean);
    procedure SetHint(Value: string);
    procedure SetIconVisible(Value: Boolean);
    procedure SetPopupMenu(Value: TPopupMenu);
    procedure SendTrayMessage(Msg: DWORD; Flags: UINT);
    function ActiveIconHandle: THandle;
  protected
    procedure Loaded; override;
    procedure LoadDefaultIcon; virtual;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Icon: TIcon read FIcon write SetIcon;
    property HideTask: Boolean read FHideTask write SetHideTask default False;
    property Hint: String read FHint write SetHint;
    property IconVisible: Boolean read FIconVisible write SetIconVisible default False;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
  end;

procedure Register;

implementation
procedure Register;
begin
  RegisterComponents(`Ruzne`, [TTrayIkona]);
end;


{ TIconManager }
type
  TIconManager = class
  private
    FHWindow: HWnd;
    procedure TrayWndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    property HWindow: HWnd read FHWindow write FHWindow;
  end;

var
  IconMgr: TIconManager;
  DDGM_TRAYICON: Cardinal;

constructor TIconManager.Create;
begin
  FHWindow := Classes.AllocateHWnd(TrayWndProc);
end;

destructor TIconManager.Destroy;
begin
  if FHWindow <> 0 then Classes.DeallocateHWnd(FHWindow);
  inherited Destroy;
end;

procedure TIconManager.TrayWndProc(var Message: TMessage);
var
  Pt: TPoint;
  TheIcon: TTrayIkona;
begin
  with Message do
  begin
    if (Msg = DDGM_TRAYICON) then
    begin
      TheIcon := TTrayIkona(WParam);
      case lParam of
        WM_LBUTTONDOWN:
          if (Assigned(TheIcon.FOnClick) then
            TheIcon.FOnClick(Self);
        WM_RBUTTONDOWN:
          begin
            if Assigned(TheIcon.FPopupMenu) then
            begin
              SetForegroundWindow(IconMgr.HWindow);
              GetCursorPos(Pt);
              TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
              PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
            end;
          end;
      end;
    end
    else
      Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
  end;
end;

{ TTrayIkona }

constructor TTrayIkona.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  LoadDefaultIcon;
end;

destructor TTrayIkona.Destroy;
begin
  if FIconVisible then SetIconVisible(False);
  FIcon.Free;
  inherited Destroy;
end;

function TTrayIkona.ActiveIconHandle: THandle;
begin
  if (FIcon.Handle <> 0) then
    Result := FIcon.Handle
  else
    Result := FDefaultIcon;
end;

procedure TTrayIkona.LoadDefaultIcon;
begin
  FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;

procedure TTrayIkona.Loaded;
begin
  inherited Loaded;
  if FIconVisible then
    SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;

procedure TTrayIkona.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = PopupMenu) then
    PopupMenu := nil;
end;


procedure TTrayIkona.SendTrayMessage(Msg: DWORD; Flags: UINT);
begin
  with Tnd do
  begin
    cbSize := SizeOf(Tnd);
    StrPLCopy(szTip, PChar(FHint), SizeOf(szTip));
    uFlags := Flags;
    uID := UINT(Self);
    Wnd := IconMgr.HWindow;
    uCallbackMessage := DDGM_TRAYICON;
    hIcon  := ActiveIconHandle;
  end;
  Shell_NotifyIcon(Msg, @Tnd);
end;

procedure TTrayIkona.SetHideTask(Value: Boolean);
const
  ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
  if FHideTask <> Value then
  begin
    FHideTask := Value;
    if not (csDesigning in ComponentState) then
      ShowWindow(Application.Handle, ShowArray[FHideTask]);
  end;
end;

procedure TTrayIkona.SetHint(Value: string);
begin
  if FHint <> Value then
  begin
    FHint := Value;
    if FIconVisible then
      SendTrayMessage(NIM_MODIFY, NIF_TIP);
  end;
end;

procedure TTrayIkona.SetIcon(Value: TIcon);
begin
  FIcon.Assign(Value);
  if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;

procedure TTrayIkona.SetIconVisible(Value: Boolean);
const
  MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
  if FIconVisible <> Value then
  begin
    FIconVisible := Value;
    SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
  end;
end;

procedure TTrayIkona.SetPopupMenu(Value: TPopupMenu);
begin
  FPopupMenu := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

const
  TrayMsgStr = `DDG.TrayNotifyIconMsg`;

initialization
  DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
  IconMgr := TIconManager.Create;
finalization
  IconMgr.Free;
end.

Na závěr

Dnes jsme dokončili jeden z nejobtížnějších úkolů v historii tohoto seriálu. Je možné, že pro některé začínající čtenáře byly určité fragmenty nepochopitelné, a to i přes mou maximální snahu vše podrobně vysvětlit. Patříte-li mezi takové čtenáře, rád bych vás ujistil, že jsme dnes a v předchozích dílech zabrousili do skutečně obtížné problematiky.

Vytvořenou komponentu si nyní můžete snadno vyzkoušet v libovolné aplikaci. Abyste to však mohli provést, je nutné komponentu nainstalovat do palety. Přestože jsme se s tímto problémem v seriálu již setkali, pro jistotu společně komponentu nainstalujeme a vyzkoušíme za týden.