TrayIcon アプリケーション

参照元


redball.gif目次へ戻る

以前つかっていた某有名メーラソフトや、現在使っている家庭内無線ＬＡＮの無線電波状況を示すソフトは、ウィンドウを最小化してもタスクバーに表示されず、タスクトレイにアイコンを表示して、そのアイコンにマウスでアクセスすることにより、ユーザが制御できるようになっている。このような機能はどのようにして実現されているのだろうか。ここでは、参照元を参考にしてタスクトレイ（正式にはステータスエリア Status Area というらしい）にアイコンを表示する機構を試してみよう。

タスクトレイにアイコンを表示して、そこからのメッセージを受け取るためには ShellAPI にある

function Shell_NotifyIcon(dwMessage: DWORD; 
                             lpData: PNotifyIconData): BOOL; stdcall;

を実行して「登録」する必要がある。この第一パラメータには、以下の定数を設定できる。

const
  NIM_ADD         = $00000000;  // 新たに登録する
  NIM_MODIFY      = $00000001;  // 登録内容を変更する
  NIM_DELETE      = $00000002;  // 登録を解除する

第二パラメータには、以下のレコード型へのポインタを設定する。

type
  PNotifyIconDataA = ^TNotifyIconDataA;
  PNotifyIconData = PNotifyIconDataA;
  _NOTIFYICONDATAA = record
    cbSize: DWORD;               // このレコード型のサイズ
    Wnd: HWND;                   // メッセージを受け取るウィンドウのハンドル
    uID: UINT;                   // アプリ定義の数値
    uFlags: UINT;                // どのフィールドが有効かを示すフラグ（以下を参照）
    uCallbackMessage: UINT;      // アプリケーション定義のメッセージＩＤ
    hIcon: HICON;                // タスクトレイに表示するアイコンのハンドル
    szTip: array [0..63] of AnsiChar; // ツールチップの文字列
  end;
  _NOTIFYICONDATA = _NOTIFYICONDATAA;
  TNotifyIconDataA = _NOTIFYICONDATAA;
  TNotifyIconData = TNotifyIconDataA;
  NOTIFYICONDATAA = _NOTIFYICONDATAA;
  NOTIFYICONDATA = NOTIFYICONDATAA;

uFlags には、以下の定数の組み合わせ（ or で結合できる）を設定できる。

const
  NIF_MESSAGE     = $00000001;  // uCallbackMessage フィールドが有効
  NIF_ICON        = $00000002;  // hIcon フィールドが有効
  NIF_TIP         = $00000004;  // szTip フィールドが有効

トレイに表示されたアイコンからのマウスメッセージは、Wnd で識別されるウィンドウに uCallbackMessage のメッセージとして送られてくる。この LParam には、WM_RBUTTONDOWN などのメッセージＩＤが入っており、WParam には、上記の uID で設定した数値が入っている。それではさっそくやってみよう。uses に ShellAPI を追加して以下のようにする。

List 1

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    NID:TNotifyIconData;
    WM_CALLBACK_MESSAGE:UINT;
    procedure WndProc(var Message: TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  WM_CALLBACK_MESSAGE := RegisterWindowMessage('HogeTrayIcon');

  FillChar(NID,SizeOf(TNotifyIconData),#0);
  NID.cbSize := SizeOf(TNotifyIconData);
  NID.Wnd := Handle;
  NID.hIcon := Application.Icon.Handle;
  NID.uCallbackMessage := WM_CALLBACK_MESSAGE;
  NID.uID := 123;
  StrPLCopy(NID.szTip,Application.Title,63);
  NID.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  Shell_NotifyIcon(NIM_ADD,@NID);

  Randomize;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@NID);
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;
  if Message.Msg = WM_CALLBACK_MESSAGE then
    case Message.LParam of
      WM_RBUTTONDOWN:begin
        SetForegroundWindow(Handle);
        Color := TColor(Random($1000000));
        Label1.Caption := IntToStr(Message.WParam);
      end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IC:TIcon;
begin
  IC := TIcon.Create;
  try
    IC.LoadFromFile('C:\Delphi5\Borland Shared\Images\Icons\chemical.ico');
    NID.hIcon := IC.Handle;
    NID.uFlags := NIF_ICON;
    Shell_NotifyIcon(NIM_MODIFY,@NID);
  finally
    IC.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  s:string;
begin
  s := 'ヒントを変更しました';
  StrPLCopy(NID.szTip,s,Length(s));
  NID.uFlags := NIF_TIP;
  Shell_NotifyIcon(NIM_MODIFY,@NID);
end;

end.
n01701.gif

実行すると右図のようになる。タスクトレイの該当するアイコンの上にマウスカーソルを持っていくと、図のようにツールチップが表示される。アイコンを右クリックすると、そのたびに Form1 の背景色がランダムに変更される。Label1 には uID が設定したとおりに表示される。Button1 を押すとアイコンが変更される。Button2 を押すとツールチップが変更される。


コードを調べよう。登録は FormCreate イベントハンドラで行っている。

procedure TForm1.FormCreate(Sender: TObject);
begin
  WM_CALLBACK_MESSAGE := RegisterWindowMessage('HogeTrayIcon');

  FillChar(NID,SizeOf(TNotifyIconData),#0);
  NID.cbSize := SizeOf(TNotifyIconData);
  NID.Wnd := Handle;
  NID.hIcon := Application.Icon.Handle;
  NID.uCallbackMessage := WM_CALLBACK_MESSAGE;
  NID.uID := 123;
  StrPLCopy(NID.szTip,Application.Title,63);
  NID.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  Shell_NotifyIcon(NIM_ADD,@NID);

  Randomize;
end;

ここでは、適当な文字列をつかって OS にカスタムメッセージを割り当ててもらっている。そして、NID の各フィールドを設定している。この例では、受信ウィンドウとして Form1 を設定している。最後に Shell_NotifyIcon(NIM_ADD,@NID); で登録している。登録解除は FormDestroy で行っている。メッセージは、WM_CALLBACK_MESSAGE を変数で宣言しているのでメッセージ処理ハンドラは使えないので、TForm1 の WndProc() をオーバーライドして捕まえている。

procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;
  if Message.Msg = WM_CALLBACK_MESSAGE then
    case Message.LParam of
      WM_RBUTTONDOWN:begin
        SetForegroundWindow(Handle);
        Color := TColor(Random($1000000));
        Label1.Caption := IntToStr(Message.WParam);
      end;
    end;
end;

ここでは、WM_RBUTTONDOWN メッセージだけを捕まえて Form1 の背景色を変更している。アイコンの変更は

procedure TForm1.Button1Click(Sender: TObject);
var
  IC:TIcon;
begin
  IC := TIcon.Create;
  try
    IC.LoadFromFile('C:\Delphi5\Borland Shared\Images\Icons\chemical.ico');
    NID.hIcon := IC.Handle;
    NID.uFlags := NIF_ICON;
    Shell_NotifyIcon(NIM_MODIFY,@NID);
  finally
    IC.Free;
  end;
end;

で行っている。NID の変更部分だけ設定して、Shell_NotifyIcon(NIM_MODIFY,@NID); を実行している。OS は Wnd 部分と uID 部分をみて、どの登録を変更するのかを識別するので、これらの部分は一度設定したら変更しないようにする。ツールチップの変更も同様である。

ここまでで、トレイアイコンアプリケーションの骨格部分はできたので、あとはアイコンを右クリックしたときにポップアップメニューを表示し、フォームを最小化したときにタスクバーのボタンに現れないようにすると完成である。前回のプログラムに、PopupMenu1 と ApplicationEvents1 を追加して以下のように変更する。

List 2

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    PopupMenu1: TPopupMenu;
    ApplicationEvents1: TApplicationEvents;
    Red1: TMenuItem;
    Green1: TMenuItem;
    Blue1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure ApplicationEvents1Restore(Sender: TObject);
    procedure Red1Click(Sender: TObject);
    procedure Green1Click(Sender: TObject);
    procedure Blue1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    NID:TNotifyIconData;
    WM_CALLBACK_MESSAGE:UINT;
    procedure WndProc(var Message: TMessage); override;
    procedure ShowPopupMenu;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  WM_CALLBACK_MESSAGE := RegisterWindowMessage('HogeTrayIcon');

  FillChar(NID,SizeOf(TNotifyIconData),#0);
  NID.cbSize := SizeOf(TNotifyIconData);
  NID.Wnd := Handle;
  NID.hIcon := Application.Icon.Handle;
  NID.uCallbackMessage := WM_CALLBACK_MESSAGE;
  NID.uID := 123;
  StrPLCopy(NID.szTip,Application.Title,63);
  NID.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  Shell_NotifyIcon(NIM_ADD,@NID);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@NID);
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;
  if Message.Msg = WM_CALLBACK_MESSAGE then
    case Message.LParam of
      WM_RBUTTONDOWN:ShowPopUpMenu;
      WM_LBUTTONDBLCLK:Application.Restore;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IC:TIcon;
begin
  IC := TIcon.Create;
  try
    IC.LoadFromFile('C:\Delphi5\Borland Shared\Images\Icons\chemical.ico');
    NID.hIcon := IC.Handle;
    NID.uFlags := NIF_ICON;
    Shell_NotifyIcon(NIM_MODIFY,@NID);
  finally
    IC.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  s:string;
begin
  s := 'ヒントを変更しました';
  StrPLCopy(NID.szTip,s,Length(s));
  NID.uFlags := NIF_TIP;
  Shell_NotifyIcon(NIM_MODIFY,@NID);
end;

procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
  ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TForm1.ApplicationEvents1Restore(Sender: TObject);
begin
  SetForegroundWindow(Application.Handle);
end;

procedure TForm1.ShowPopupMenu;
var 
  Pt: TPoint; 
begin
  SetForegroundWindow(Handle);
  GetCursorPos(Pt);
  PopupMenu1.Popup(Pt.X, Pt.Y);
end;

procedure TForm1.Red1Click(Sender: TObject);
begin
  Application.Restore;
  Color := clRed;
end;

procedure TForm1.Green1Click(Sender: TObject);
begin
  Application.Restore;
  Color := clGreen;
end;

procedure TForm1.Blue1Click(Sender: TObject);
begin
  Application.Restore;
  Color := clBlue;
end;

end.
n01702.gif

実行すると右図のようになる。


最小化したときタスクバーに表示されないようにするには、

procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
  ShowWindow(Application.Handle,SW_HIDE);
end;

のようにして、Application ウィンドウを非表示にする。ここでは、トレイアイコンを左ダブルクリックしたときに復帰するようにした。

procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;
  if Message.Msg = WM_CALLBACK_MESSAGE then
    case Message.LParam of
      WM_RBUTTONDOWN:ShowPopUpMenu;
      WM_LBUTTONDBLCLK:Application.Restore;
    end;
end;

また、WM_RBUTTONDOWN を捕まえてポップアップメニューを表示している。

procedure TForm1.ShowPopupMenu;
var 
  Pt: TPoint; 
begin
  SetForegroundWindow(Handle);
  GetCursorPos(Pt);
  PopupMenu1.Popup(Pt.X, Pt.Y);
end;

このように、GetCursorPos() によりマウスカーソルのスクリーン座標を取得して、そこにポップアップメニューを表示する。

最後に以上の機能をコンポーネントにしてみよう。

List 3

unit TrayIconUnit;

interface

uses
  Windows, Messages, ShellApi, SysUtils, Graphics,
  Controls, Forms, Classes, AppEvnts;

type
TTrayIcon = class(TComponent)
private
  NID:TNotifyIconData;
  WM_CALLBACK_MESSAGE:UINT;
  FHandle:HWND;
  FClickFlag:Boolean;
  FHint:string;
  FIcon:TIcon;
  FHideMinimize:Boolean;
  FAppEvents:TApplicationEvents;
  FOnClick:TNotifyEvent;
  FOnDblClick:TNotifyEvent;
  FOnMouseMove:TMouseMoveEvent;
  FOnMouseDown:TMouseEvent;
  FOnMouseUp:TMouseEvent;
  procedure SetHint(const Value: string);
  procedure SetIcon(const Value: TIcon);
protected
  procedure OnMessage(var Msg:TMessage); virtual;
  procedure Modify;
  function GetShiftState:TShiftState;
  procedure Click;virtual;
  procedure DblClick;virtual;
  procedure MouseMove(Shift:TShiftState; X,Y:integer);virtual;
  procedure MouseDown(Button:TMouseButton;
                     Shift:TShiftState; X,Y:integer);virtual;
  procedure MouseUp(Button:TMouseButton;
                     Shift:TShiftState; X,Y:integer);virtual;
  procedure Loaded;override;
public
  constructor Create(Owner: TComponent); override;
  destructor Destroy; override;
  procedure AppMinimize(Sender:TObject);
  procedure AppRestore(Sender:TObject);
published
  property Hint:string read FHint write SetHint;
  property Icon:TIcon read FIcon write SetIcon;
  property HideMinimize:Boolean read FHideMinimize write FHideMinimize;
  property OnClick: TNotifyEvent read FOnClick write FOnClick;
  property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
end;

procedure Register;

implementation

{ TTrayIcon }

procedure Register; 
begin 
  RegisterComponents('Samples',[TTrayIcon]); 
end;

constructor TTrayIcon.Create(Owner: TComponent);
begin
  inherited;
  FIcon := TIcon.Create;
  Icon := Application.Icon;
  if not (csDesigning in ComponentState) then begin
    FAppEvents := TApplicationEvents.Create(self);
    FAppEvents.OnMinimize := AppMinimize;
    FAppEvents.OnRestore := AppRestore;

    WM_CALLBACK_MESSAGE := RegisterWindowMessage('HogeTrayIcon');
    FHandle := AllocateHwnd(OnMessage);

    FillChar(NID,SizeOf(TNotifyIconData),#0);
    NID.cbSize := SizeOf(TNotifyIconData);
    NID.Wnd := FHandle;
    NID.hIcon := FIcon.Handle;
    NID.uCallbackMessage := WM_CALLBACK_MESSAGE;
    NID.uID := FHandle;
    StrPLCopy(NID.szTip,Application.Title,SizeOf(NID.szTip)-1);
    NID.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    Shell_NotifyIcon(NIM_ADD,@NID);
  end;
end;

destructor TTrayIcon.Destroy;
begin
  FIcon.Free;
  if not (csDesigning in ComponentState) then begin
    Shell_NotifyIcon(NIM_DELETE,@NID);
    DeallocateHwnd(FHandle);
  end;
  inherited;
end;

procedure TTrayIcon.OnMessage(var Msg: TMessage);
var 
  Pt:TPoint;
  Shift:TShiftState;
begin
  if (Msg.Msg = WM_CALLBACK_MESSAGE) and (Msg.WParam = WPARAM(FHandle)) then
    case Msg.LParam of
      WM_MOUSEMOVE    :begin
        Shift := GetShiftState;
        GetCursorPos(Pt); 
        MouseMove(Shift,Pt.x,Pt.y);
      end;
      WM_LBUTTONDOWN  :begin
        Shift := GetShiftState + [ssLeft];
        GetCursorPos(Pt);
        MouseDown(mbLeft,Shift,Pt.x,Pt.y);
        FClickFlag := true;
      end;
      WM_LBUTTONUP    :begin
        Shift := GetShiftState + [ssLeft];
        GetCursorPos(Pt);
        if FClickFlag then begin
          FClickFlag := false;
          Click;
        end;
        MouseUp(mbLeft,Shift,Pt.x, Pt.y);
      end;
      WM_LBUTTONDBLCLK:DblClick;
      WM_RBUTTONDOWN  :begin
        Shift := GetShiftState + [ssRight];
        GetCursorPos(Pt);
        MouseDown(mbRight,Shift,Pt.x,Pt.y);
      end;
      WM_RBUTTONUP    :begin
        Shift := GetShiftState + [ssRight];
        GetCursorPos(Pt);
        MouseUp(mbRight,Shift,Pt.x, Pt.y);
      end;
      WM_RBUTTONDBLCLK:DblClick;
    end // case
  else
    Msg.Result := DefWindowProc(FHandle,Msg.Msg,MSg.WParam,Msg.LParam);

end;

procedure TTrayIcon.Modify;
begin 
  if not (csDesigning in ComponentState) then Shell_NotifyIcon(NIM_MODIFY,@NID);
end;

procedure TTrayIcon.Loaded;
begin
  inherited;
  NID.hIcon := FIcon.Handle;
  NID.uFlags := NIF_ICON;
  Modify;
end;

function TTrayIcon.GetShiftState:TShiftState;
begin
  Result := [];
  if GetKeyState(VK_SHIFT) < 0 then Include(Result,ssShift);
  if GetKeyState(VK_CONTROL) < 0 then Include(Result,ssCtrl);
  if GetKeyState(VK_MENU) < 0 then Include(Result,ssAlt);
end;

procedure TTrayIcon.Click;
begin
  if Assigned(FOnClick) then FOnClick(self);
end;

procedure TTrayIcon.DblClick;
begin
  if Assigned(FOnDblClick) then FOnDblClick(self);
end;

procedure TTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
begin
  if Assigned(FOnMouseDown) then FOnMouseDown(self,Button,Shift,X,Y);
end;

procedure TTrayIcon.MouseMove(Shift: TShiftState; X, Y: integer);
begin
  if Assigned(FOnMouseMove) then FOnMouseMove(self,Shift,X,Y);
end;

procedure TTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: integer);
begin
  if Assigned(FOnMouseUp) then FOnMouseUp(self,Button,Shift,X,Y);
end;

procedure TTrayIcon.SetHint(const Value: string);
begin
  if FHint <> Value then begin
    FHint := Value;
    StrPLCopy(NID.szTip,Value,SizeOf(NID.szTip)-1);
    NID.uFlags := NIF_TIP;
    Modify;
  end;
end;

procedure TTrayIcon.SetIcon(const Value: TIcon);
begin
  if FIcon <> Value then begin
    FIcon.Assign(Value);
    NID.hIcon := FIcon.Handle;
    NID.uFlags := NIF_ICON;
    Modify;
  end;
end;

procedure TTrayIcon.AppMinimize(Sender:TObject);
begin
  if FHideMinimize then ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TTrayIcon.AppRestore(Sender:TObject);
begin
  if FHideMinimize then SetForegroundWindow(Application.Handle);
end;

end.
n01703.gif

このコンポーネントの HideMinimize はデフォルトでは false であるが、オブジェクトインスペクタで true にすると最小化のときにタスクバーに表示されなくなる。あとのプロパティーやイベントハンドラについては説明はいらないだろう。それではこのコンポーネントをテストしてみよう。右図のように TrayIcon1 と Button1 と PopupMenu1 と ImageList1 を置いて、TrayIcon1 のプロパティーを適当に設定する。


n01704.gif

また、ImageList1 をダブルクリックして予め４つのアイコンを右図のように読み込んでおく。HideMinimize を true にしたときは必ず復帰する手段を設定しておくことを忘れないように。以下に全リストを示す。


List 4

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TrayIconUnit, StdCtrls, Menus, ImgList;

type
  TForm1 = class(TForm)
    TrayIcon1: TTrayIcon;
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    Red1: TMenuItem;
    Green1: TMenuItem;
    Blue1: TMenuItem;
    ImageList1: TImageList;
    procedure TrayIcon1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Red1Click(Sender: TObject);
    procedure Green1Click(Sender: TObject);
    procedure Blue1Click(Sender: TObject);
    procedure TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
  Application.Restore;
end;

var
  IconIndex:integer;

procedure TForm1.Button1Click(Sender: TObject);
var
  IC:TIcon;
begin
  IC := TIcon.Create;
  try
    Inc(IconIndex);
    if IConIndex > 3 then IconIndex := 0;
    ImageList1.GetIcon(IconIndex,IC);
    TrayIcon1.Icon := IC;
   finally
    IC.Free;
  end;
end;

procedure TForm1.Red1Click(Sender: TObject);
begin
  Application.Restore;
  Color := clRed;
end;

procedure TForm1.Green1Click(Sender: TObject);
begin
  Application.Restore;
  Color := clGreen;
end;

procedure TForm1.Blue1Click(Sender: TObject);
begin
  Application.Restore;
  Color := clBlue;
end;

procedure TForm1.TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then begin
    SetForegroundWindow(Handle);
    PopupMenu1.Popup(X,Y);
  end;
end;

end.
n01705.gif

実行すると右図のようになる。ここでは HideMinimize を true にして、アイコンを左クリックしたときに最小化から復帰している。Button1Click では、ImageList1 に設定したアイコンを循環的にトレイアイコンに設定している。


以上、トレイアイコンアプリケーションの仕組みを簡単に調べ、それ用のコンポーネントを作成した。

redball.gif目次へ戻る