Tipy a triky v Delphi, díl 63.

I dnešní tip bude poněkud zaměřen na Windows XP, i když příklad by vám měl fungovat i v jiných verzích. Budeme se zabývat "balónovými hinty".
Tzv. balónové hinty, tedy poněkud vylepšená klasická bublinková nápověda, která se objevuje u ikon na hlavním panelu vedle hodin, se ve větší míře začaly objevovat až s příchodem Windows XP, i když v jisté omezené míře fungují i pod Windows 2000 či ME (stejně jako náš dnešní příklad).

Kromě výrazně změněného vzhledu samotné "bubliny", která teď už vypadá skutečně jako komiksová bublina, se drobně odlišuje i text. Bublina obsahuje jednak jakýsi nadpis, který je napsán tučněji než samotný text a pak pochopitelně samotnou zprávu uživateli, která může být několikařádková. Dále je zde drobná ikonka, symbolizující druh zprávy (podobně jako u klasických message dialogů) a rovněž tlačítko na uzavření tohoto malého "okna". Ale dost popisu, všichni víte, oč se jedná.

Náš příklad tedy ve zkratce provede to, že po spuštění se přidá do hlavního panelu ikonka naší aplikace a zobrazí se balónový hint s krátkým textem. Po uplynutí zadaného času (nastaven na 3 sekundy) nebo kliknutí uživatele pak nápověda zmizí.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI;

const
  NIF_INFO = $10;
  NIF_MESSAGE = 1;
  NIF_ICON = 2;
  NOTIFYICON_VERSION = 3;
  NIF_TIP = 4;
  NIM_SETVERSION = $00000004;
  NIM_SETFOCUS = $00000003;
  NIIF_INFO = $00000001;
  NIIF_WARNING = $00000002;
  NIIF_ERROR = $00000003;
  NIN_BALLOONSHOW = WM_USER + 2;
  NIN_BALLOONHIDE = WM_USER + 3;
  NIN_BALLOONTIMEOUT = WM_USER + 4;
  NIN_BALLOONUSERCLICK = WM_USER + 5;
  NIN_SELECT = WM_USER + 0;
  NINF_KEY = $1;
  NIN_KEYSELECT = NIN_SELECT or NINF_KEY;
  TRAY_CALLBACK = WM_USER + $7258;

type
  PNewNotifyIconData = ^TNewNotifyIconData;
  TDUMMYUNIONNAME = record
    case Integer of
      0: (uTimeout: UINT);
      1: (uVersion: UINT);
  end;

  TNewNotifyIconData = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array [0..127] of Char;
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array [0..255] of Char;
    DUMMYUNIONNAME: TDUMMYUNIONNAME;
    szInfoTitle: array [0..63] of Char;
    dwInfoFlags: DWORD;
  end;


type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    IconData: TNewNotifyIconData;
    procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
    procedure AddSysTrayIcon;
    procedure ShowBalloonTips;
    procedure DeleteSysTrayIcon;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SysTrayIconMsgHandler(var Msg: TMessage);
begin
  case Msg.lParam of
    WM_MOUSEMOVE:;
    WM_LBUTTONDOWN:;
    WM_LBUTTONUP:;
    WM_LBUTTONDBLCLK:;
    WM_RBUTTONDOWN:;
    WM_RBUTTONUP:;
    WM_RBUTTONDBLCLK:;
    NIN_BALLOONSHOW:;
    NIN_BALLOONHIDE:;
    NIN_BALLOONTIMEOUT:;
    NIN_BALLOONUSERCLICK:;
  end;
end;

procedure TForm1.AddSysTrayIcon;
begin
  IconData.cbSize := SizeOf(IconData);
  IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler);
  IconData.uID := 0;
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  IconData.uCallbackMessage := TRAY_CALLBACK;
  IconData.hIcon := Application.Icon.Handle;
  IconData.szTip := `Toto je testovací nápověda.`;
  if not Shell_NotifyIcon(NIM_ADD, @IconData) then ShowMessage(`Chyba, nepodařilo se vložit ikonu do hlavního panelu !`);
end;

procedure TForm1.ShowBalloonTips;
var
  TipInfo, TipTitle: string;
begin
  IconData.cbSize := SizeOf(IconData);
  IconData.uFlags := NIF_INFO;
  TipInfo := `Toto je testovací nápověda.`;
  strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1);
  IconData.DUMMYUNIONNAME.uTimeout := 3000;
  TipTitle := `Upozornění`;
  strPLCopy(IconData.szInfoTitle, TipTitle, SizeOf(IconData.szInfoTitle) - 1);
  IconData.dwInfoFlags := NIIF_INFO;
  Shell_NotifyIcon(NIM_MODIFY, @IconData);
  IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
  if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then ShowMessage(`Chyba ve verzi.`);
end;

procedure TForm1.DeleteSysTrayIcon;
begin
  DeallocateHWnd(IconData.Wnd);
  if not Shell_NotifyIcon(NIM_DELETE, @IconData) then ShowMessage(`Chyba, nepodařilo se odstranit ikonu z hlavního panelu.`);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AddSysTrayIcon;
  ShowBalloonTips;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteSysTrayIcon;
end;

end.

Při úpravě kódu je pro vás důležitá hlavně procedura ShowBalloonTips, kde najdete jednak texty, které se budou v nápovědě zobrazovat (tedy nadpis a vlastní zpráva) a dále také typ ikony. Ta je v ukázce nastavena na NIIF_INFO, tedy informační ikona. Další možnosti můžete najít v konstantách, jsou to NIIF_WARNING a NIIF_ERROR a jistě sami dobře víte, jaké ikony budou tyto názvy představovat. Rovněž zde najdete i časový interval (timeout), jak dlouho bude bublina zobrazena, ale rovnou se vám přiznám, že je třeba brát tento údaj s rezervou, neboť se nápověda zobrazí vždy na o něco delší okamžik (tedy alespoň na mém počítači).

Zajímavá je taktéž procedura SysTrayIconMsgHandler, která má na starosti zpracování zpráv o stavu nápovědy. V naší ukázce nejsou jednotlivým stavům přiřazeny žádné akce, takže si příslušné funkce doplňte dle vaší potřeby sami. Jak vidíte ze zdrojového kódu, jsou zde reakce na stisknutí tlačítka myši, skrytí či zobrazení nápovědy, uplynutí timeoutu a podobně.

A na závěr snad už jen poznámka k drobným rozdílům mezi systémy. Zatímco pod Windows XP bude zobrazena nápověda v "plné síle" včetně uzavíracího tlačítka a s efektem postupného zobrazování a pohasínání, pod Windows 2000 bude toto tlačítko i efekt chybět. Nemám představu, jak bude situace vypadat pod Windows ME, ale předpokládám že stejně jako pod Windows 2000. A konečně pod Windows 98 (či staršími systémy) se nezobrazí nic, pouze ikona v hlavním panelu a varovné upozornění, které je tam pochopitelně pouze pro naše testovací účely a v opravdových aplikacích není samozřejmě nutné tímto dialogem uživatele obtěžovat.

Diskuze (5) Další článek: Společnost IBM uzavře maďarský závod na výrobu pevných disků

Témata článku: , , , , , , , , , , , , , , ,