Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年02月19日] [更新 2021年12月12日] Delphi サンプルプログラム集
372_フォームを使用しないタスクトレイ常駐アプリ
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
後半は Windows 10 ビルド 19042 + Delphi XE5(UP2) Pro VCL-32
372_TrayIconNoForm.zip [4,2 MB] 2021年12月12日版 (EXE 同梱)







タスクトレイに常駐するアプリ


タスクトレイ (通知領域) 常駐アプリの作成の参考コードです.
元々は,フォームを使用しない常駐アプリケーションの作成方法の質問の回答用として作成したサンプルですが,比較のために,フォームを使用するサンプルも掲載しています.フォームのアイコンをタスクバーに表示または非表示するテストもしています.




01_フォームを使用しないタスクトレイ常駐アプリ


フォームを使用しないタスクトレイ常駐アプリの参考例です.
フォームを使用しない場合は,拡張子が .dpr のプロジェクトファイル内,あるいはユニットを追加していればそのニット内にコードを書くことになります.

本サンプルは,Delphi のコミュニティの場のレス用に作成したものですが,フォームを使用しないアプリケーションというのは,Delphi 本来の利便さをある意味では放棄することになります.
タスクトレイに表示されているアイコンをクリックして,メニュー等を表示するとか,設定用のダイアログを表示するとか,各種のコンポーネントを使用する場合,全て実行時に生成して制御するコードを作成しなければなりません.これは結構面倒な作業です.
このサンプルでは,アプリケーションのウィンドウプロシージャーを置き換えて処理しています.

このようなフォームを使用しないアプリの作成は,RAD での開発環境がない時代のコードが参考になります.例えば,[第1章 窓をあければ] 等の Halbow 資料館のコードが参考になります.Halbow 資料館のこれらはサンプルは,フォームを表示していますが,Delphi のフォームユニットは使用していません.メッセージやイベントハンドラを .dpr や 各ユニット内に実装しています.

ホットキーを登録していますが,すでに同じホットキーが登録されているかのチェックはしていません.実際のアプリでホットキーを使用する際は,そのチェックも必要です.Delphi の IDE でもそうですが,システムには非常に多くのホットキー,ショートカットキーが登録されています.


[注意]
このサンプルは,定義した MainAppProc を通過しないメッセージは処理できません.したがって,ダイアログの表示に MessageDlg 関数を使用していますが,他の関数では表示できない場合があります.IDE から実行して表示できても,EXE の単独起動では表示に失敗し,プロセスが終了できずに,常駐が終了しない場合があります.ShowMessage 関数であれば表示できます.



図1
EXE を起動すると常駐する
図2
アイコン上でマウスクリック
図3
[Ctrl] + [A] 押下で常駐終了

リスト1
フォームを使用しないタスクトレイ常駐アプリの例
program TrayIconNonForm;

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

{$R *.RES}

var
  Msg         : TMsg;
  NotifyIcon  : TNotifyIconData;
  HotKeyID1   : Integer;
  SetKey1     : Cardinal;
  SetShift1   : Cardinal;

//-----------------------------------------------------------------------------
//  トレイアイコンとホットキーの登録
//-----------------------------------------------------------------------------
procedure TrayIconTouroku;
begin
  //トレイアイコンの情報の初期化
  FillChar(NotifyIcon, SizeOf(TNotifyIconData), #0);
  //各種情報を設定
  NotifyIcon.cbSize           := SizeOf(TNotifyIconData);
  NotifyIcon.Wnd              := Application.Handle;
  NotifyIcon.hIcon            := Application.Icon.Handle;
  NotifyIcon.uCallbackMessage := WM_APP + 100;
  NotifyIcon.uID              := 1;
  NotifyIcon.uFlags           := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  StrPLCopy(NotifyIcon.szTip, PChar('常駐アプリテスト'), 64);
  //トレイアイコンの登録
  Shell_NotifyIcon(NIM_ADD,Addr(NotifyIcon));


  //グローバルホットキー(ショートカットキー)の登録
  //多い場合は配列の使用が良
  SetKey1   := Ord('A');
  SetShift1 := MOD_CONTROL;
  HotKeyID1 := GlobalAddAtom('MyHotkey1');
  RegisterHotKey(Application.Handle, HotKeyID1, SetShift1, SetKey1);
end;

//-----------------------------------------------------------------------------
//  メッセージ処理用ウィンドウプロシージャー
//  [Ctrl]+[A]キーで常駐終了
//  タスクトレイの本アプリのアイコン上のマウス右ボタン押下でメッセージを表示
//-----------------------------------------------------------------------------
function MainAppProc(hWindow: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM):
  LRESULT; stdcall; export;
begin
  Result := 0;

  case Msg of
  WM_HOTKEY:
    begin
      PostQuitMessage(0);
    end;
  WM_APP + 100:
    begin
      if LParam = WM_RBUTTONDOWN then begin
        MessageDlg('トレイアイコンで,マウス右ボタンが押されました',
                   mtInformation,
                   [mbOK],
                   0);
        //ダイアログを[X]ボタンで閉じてしまった場合の対策
        //[X]ボタンと[Alt]+[F4]では常駐を終了させない
        Result := 1;
      end;
    end;
  else
    begin
      Result := DefWindowProc( hWindow, Msg, wParam, lParam );
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ホットキーとトレイアイコンの登録削除
//-----------------------------------------------------------------------------
procedure TrayIconOwari;
begin
  //グロパールホットキーの登録解除
  GlobalDeleteAtom(HotkeyID1);
  UnRegisterHotKey(Application.Handle, HotKeyID1);

  //トレイアイコンの削除
  Shell_NotifyIcon(NIM_DELETE, @NotifyIcon);
end;

//=============================================================================
//  このサンプルは
//  1. タスクバーにアプリのアイコンを表示しない
//  2. メインフォーム非表示(作成していない)
//  3. メッセージを処理するためにウィンドウプロシージャーを置き換える
//  4. タスクトレイにアイコンを登録し[Ctrl]+[A]を検出すと終了する
//=============================================================================
begin
  //メッセージ処理のためにアプリのウィンドウプロシージャーを置き換える
  SetWindowLong(Application.Handle, GWL_WNDPROC, NativeInt(@MainAppProc));

  TrayIconTouroku;
  //終了のメッセージがくるまでループ
  while GetMessage(Msg, 0, 0, 0) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  TrayIconOwari;

  MessageDlg('終了です', mtInformation, [mbOK], 0);
  System.Halt(Msg.wParam);
end.




02_フォームを使用するタスクトレイ常駐アプリ - TTrayIcon コンポ


フォームを使用するタスクトレイ常駐アプリのテストサンプルです.
常駐アプリでは,たとえフォームを表示する必要がなくても,いろいろなコンポーネントを利用したり,メッセージの処理コードの実装が楽になります.
このサンプルでは,メインフォームだけです.このメインフォームをダイアログがわりに表示します.

本サンプルは,コンポーネントパレットの [Additional] タブにある TTrayIcon コンポーネントを使用しています.

上のサンプルでは,この TTrayIcon コンポーネントを使用していません.
上のサンプルで,もし,TTrayIcon コンポーネントを使用して,マウスイベントやポップアップメニューの処理をするのであれば,TTrayIcon の継承クラスを作成して,その継承クラス内でイベントの定義を設定することになります.


図4
設計時画面

下図が実行結果です.
作成した EXE を実行すると,タスクトレイに常駐します.マウスの右ボタンクリックでポップアップメニューを表示します.メニューから [設定画面表示] を選択すると,フォームを表示します.


図5
EXE を実行するとタスクトレイに常駐
図6
ポップアップメニューを表示
図7
メニューで [設定画面表示} を選択
  • 設定用のフォームが表示されて
  • タスクバーに,そのフォームのアイコンが表示される

リスト2
メインフォームをダイアログに使用するタスクトレイ常駐アプリ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  CreateParamsメソッド処理
//  このメインフォーム(Form1)は起動時に表示しない
//=============================================================================
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Application.ShowMainForm := False;
end;

//=============================================================================
//  フォーム生成時の処理
//  トレイアイコンを表示する
//  ポップアップメニューを割り当てる
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.BorderStyle    := bsDialog;
  TrayIcon1.Icon      := Application.Icon;
  TrayIcon1.Visible   := True;
  TrayIcon1.Hint      := '常駐アプリテスト';
  TrayIcon1.PopupMenu := PopupMenu1;
end;

//=============================================================================
//  フォームが閉じる時の処理
//  このメインフォームの表示中はこのフォームからはアプリを終了させない
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Form1.Visible then begin
    Form1.Visible := False;
    CanClose := False;
    Exit;
  end;

  TrayIcon1.Visible := False;
end;

//=============================================================================
//  [設定終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.Visible := False;
end;

//=============================================================================
//  ボップアップメニューの[設定画面表示]
//  Form1を表示して,タスクバーにForm1のアイコンを表示
//=============================================================================
procedure TForm1.N1Click(Sender: TObject);
begin
  if Form1.Visible = False then begin
    Form1.Visible := True;
  end;
end;

//=============================================================================
//  ボップアップメニューの[終了]
//  アプリメインフォームのCloseメソッドはアプリの終了となる
//=============================================================================
procedure TForm1.N2Click(Sender: TObject);
begin
  //このフォームが表示中の時は[X]と[Alt]+[F4]で終了させないために非表示にしておく
  Form1.Visible := False;
  Close;
end;

end.


もし,メインフォーム Form1 を表示した時に,タスクバーにフォームのアイコンを表示したくない場合は,プロジェクトのソースコードで,

Application.MainFormOnTaskbar := False;

にして,メインフォームをタスクバーに表示しない設定にします.このままだと,フォームを表示した時に,タスクバーにアプリケーションウィンドウのアイコンが表示されてしまいます.
そこで,フォームを表示する時のコードを,例えば以下のように,アプリケーションウィンドウのハンドルを指定して,非表示にします.

個人的には,フォームのアイコンがタスクバーに表示されていた方が,他のウィンドウに隠れてしまった状況を考えれば便利だとは思っています.



procedure TForm1.N1Click(Sender: TObject);
begin
  if Form1.Visible = False then begin
    Form1.Visible := True;
    ShowWindow(Application.Handle, SW_HIDE); //追加
  end;
end;


図8
タスクバーにフォームのアイコンを表示しない




03_タスクトレイ常駐アプリ  -  メインフォーム以外の利用


上のサンプルでは,メインフォームをダイアログとして使用しましたが,こちらはメインフォーム以外のフォームを生成し,それをダイアログとして表示します.
メインフォームを閉じるということは,アプリケーションも閉じる,つまり終了させることになりますが,メインフォーム以外のフォームを閉じても,意識的に操作しない限りアプリケーションが終了することはありません.

このサンプルのコードでは,Form2 を表示しても,タスクバーに Form2 のアイコンが表示されません.他のウィンドウに Form2 が隠れてしまった場合は,タスクトレイのアイコン上で,マウスの右ボタンをクリックすると表示できます.


図9
設計時画面
図10
ダイアログ用のフォーム Form2 の設計時画面

下図が実行結果です.
作成した EXE を実行すると,タスクトレイに常駐します.マウスの右ボタンクリックでポップアップメニューを表示します.メニューから [設定画面表示] を選択すると,フォームを表示します.


図11
ポップアップメニューからダイアログを表示
図12
[設定画面表示] でForm2 を表示
  • Form2 のアイコンはタスクバーに表示されない

リスト3
ダイアログ表示に,メインフォーム以外のフォームを使用するタスクトレイ常駐アプリ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

//=============================================================================
//  CreateParamsメソッド処理
//  アプリケーションのアイコンをタスクバーに表示させない
//  このメインフォーム(Form1)は起動時に表示しない
//=============================================================================
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Application.ShowMainForm := False;
end;

//=============================================================================
//  フォーム生成時の処理
//  トレイアイコンを表示する
//  ポップアップメニューを割り当てる
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  TrayIcon1.Icon      := Application.Icon;
  TrayIcon1.Visible   := True;
  TrayIcon1.Hint      := '常駐アプリのテスト';
  TrayIcon1.PopupMenu := PopupMenu1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  TrayIcon1.Visible := False;
end;

//=============================================================================
//  ボップアップメニューの[設定画面表示]
//  Form2を生成して表示
//  Form2は[プロジェクト][オプション][フォーム]の設定で自動生成から除外
//=============================================================================
procedure TForm1.N1Click(Sender: TObject);
begin
  if not Assigned(Form2) then begin
    Form2 := TForm2.Create(Self);
    Form2.Show;
  end;
end;

//=============================================================================
//  ボップアップメニューの[終了]
//  アプリメインフォームのCloseメソッドはアプリの終了となる
//=============================================================================
procedure TForm1.N2Click(Sender: TObject);
begin
  Close;
end;

end.


Form2 を表示した時に,タスクバーに Form2 のアイコンを表示するには,CreateParams メソッドを実装して,例えばコードを以下のようにします.

前項のサンプルでも,フォームのアイコンをタスクバーに表示する際と,表示しない場合のコードを示しましたが,メインフォームと,メインフォーム以外のフォーム (子フォーム) の場合とでは処理が異なります.



procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  //このフォームの親はDesktopとする
  //タスクバーにForm1とは別にアイコン表示される
  Params.WndParent := GetDesktopWindow;
end;


図13
[設定画面表示] で Form2 を表示
  • Form2 のアイコンがタスクバーに表示される




04_システムの起動時にタスクトレイに常駐させる


システムの起動時にタスクトレイに常駐させるには,CSIDL が CSIDL_STARTUP,全てのユーザが対象であれば,CSIDL_COMMON_STARTUP の特殊フォルダ [スタートアップ] にショートカットを作成します.
そうすると,次回起動時に,このショートカットのプログラムが自動的に実行されます.





05_タスクトレイにバルーンヒントウインドウを表示


TTrayIcon コンポーネントには,通知メッセージ用として,下図のようなウィンドウをタスクトレイのすぐ上に表示する機能があります.一般的にバルーンヒントウィンドウと言っていますが,Windows 10 では矢印なしの矩形ウィンドウです.
表示時間はシステムの設定値で,Windows 10 のデフォルトは 5 秒です.Windows XP では 10 秒でしたから半分になっています.このウィンドウのサイズは上限があり,1 行の長さが長いと折り返し表示になります.このバルーンヒントウィンドウには [設定] と [閉じる] ボタンがあります.
Windows 10 のこのウィンドウは,UWP アプリのウィンドウです.


図14
バルーンヒントウインドウを表示
  • [閉じる] ボタンの左に [設定] ボタンがある
  • ウィンドウのサイズは制限がある
  • 長い行は折り返し表示となる
  • ウィンドウの任意の位置をクリックすると閉じる
図15
[閉じる] ボタン
  • アクションセンターにこのウィンドウの画像が格納される
  • アクションセンターを開くショートカットは [Win] + [A]
図16
指定時間後に右にスライドして見えなくなる

[設定] ボタンをクリックすると下図の表示になります.[・・・すべての通知をオフにする] を選択すると,バルーンヒントウィンドウは現れなくなります.


図17
[設定] ボタンをクリック
  • [すべての通知をオフ] にすると,バルーンヒントは現れない

同じ EXE を Windows 7 で実行すると,下図のように矢印付きとなります.表示時間が経過すると暗くなって消えていきます.


図18
Windows 7 での実行結果
  • 矢印付きとなる
図19
暗くなって消えていく

リスト4
タスクトレイにバルーンヒントウインドウを表示
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    TrayIcon1: TTrayIcon;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure TrayIcon1BalloonClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
// タスク トレイにアイコンを表示する (登録する)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // バルーンヒントウインドウが閉じるまでの時間
  // バルーンヒントウィンドウが閉じるまでの時間
  // Windows 10 では設定しても無効
  // システムの設定に従う.Windows 10 のデフォルトは 5 秒
//  TrayIcon1.BalloonTimeout := 2000;

 TrayIcon1.Icon := Application.Icon;

 TrayIcon1.Hint          := '常駐アプリテト';
  TrayIcon1.BalloonTitle := 'タイトル';
 TrayIcon1.BalloonHint   := '通知用のヒントウィンドウ' + sLineBreak
                          + 'TTrayIcon.ShowBalloonHint メソッドを実行して表示';
  TrayIcon1.BalloonFlags := bfInfo;

  TrayIcon1.Visible := True;
end;

//=============================================================================
//  フォームを閉じる時の処理
//  タスクトレイへの登録を解除 (タスクトレイのしたアイコンを非表示にする)
//  表示しているバルーンヒントウィンドウも閉じる
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  TrayIcon1.Visible := False;
end;

//=============================================================================
//  TTrayIcon のバルーンヒントウインドウを表示する
//  Windows 10 でば矢印がないウィンドウ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  TrayIcon1.ShowBalloonHint;
end;

//=============================================================================
//  TrayIcon1 の OnBalloonClick イベント
//  バルーンヒントウィンドウを [X] ボタン以外で閉じた場合
//
//  バルーンヒントウインドの任意部分をクリックでもウィンドウが閉じる
//=============================================================================
procedure TForm1.TrayIcon1BalloonClick(Sender: TObject);
var
  LText : string;
begin
  LText := 'バルーンヒントウィンドウが閉じました';
  MessageBox(Handle, PChar(lText), '情報', MB_ICONINFORMATION);
end;

end.


[備考]
Windows 10 では,TTrayIcon.ShowBalloonHint メソッドが表示するウィンドウは従来のバルーンヒントウィンドウではありません.Windows 10 ではアクションセンターによって管理する「通知」となっています.通知を表示するウィンドウもサンプルの実行結果のように矩形となっていて,表示位置も固定です.これらの通知は「トースト通知」とも呼ばれています.




06_バルーンヒントウインドウの表示時間と表示可否の設定


タスクトレイのすぐ上に表示するバルーンヒントウィンドウ (通知) は,下図の [設定] アプリの設定で変更できます.最大 5 分まで設定できます.以下のコマンドを実行すると設定画面を表示できます.

ms-settings:easeofaccess-display


図20
バルーンヒントウインドウの表示時間
  • Windows 10 のデフォルトは 5 秒
  • 最大 5 分まで設定可能

システム全体でバルーンヒントウィンドウ (通知メッセージ) の表示,非表示を設定するには,以下のコマンドで [通知とアクション] の設定を表示して,[通知] 項目の [アプリやその他の送信者からの通知を取得する] のスイッチで設定します.

ms-settings:notifications


図21
通知の設定
  • オフにはするとバルーンヒントウィドウを表示しなくなる

この後の TBalloonHint コンポーネントによるバルーンヒントの表示と,閉じるボタンのバルーンヒントのウインドウは,タスクトレイアプリ (通知領域アプリ) のウィンドウではありません.上記の設定には関係なくウィンドウを表示します.
状況によっては,この設定がオフの時はバルーンヒントウィンドウを表示しない方が,ユーザの立場としては適切かも知れません.以下は,この設定値を取得する参考コードです.


図22
通知取得のオン・オフの設定を調べる

implementation

uses
  System.Win.Registry;

{$R *.dfm}

//=============================================================================
//  システムの [通知] 項目の [アプリやその他の送信者からの通知を取得する]
//  の設定値を確認するコード
//
//  uses に System.Win.Registry が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LRegistry : TRegistry;
  LKeyName  : string;
begin
  LRegistry := TRegistry.Create;
  try
    LRegistry.Access  := KEY_READ;
    LRegistry.RootKey := HKEY_CURRENT_USER;
    LKeyName :='SOFTWARE\Microsoft\Windows\CurrentVersion\PushNotifications';
    if not LRegistry.OpenKey(LKeyName, False) then Exit;

    if LRegistry.ReadInteger('ToastEnabled') <> 0 then begin
      MessageBox(Handle, '通知の取得はオンです。', '情報', MB_ICONINFORMATION);
    end else begin
      MessageBox(Handle, '通知の取得はオフです。', '情報', MB_ICONINFORMATION);
    end;
  finally
    FreeAndNil(LRegistry);
  end;
end;


バルーンヒントウィンドウを表示する時間をシステムの [通知を表示する長さ] と同じにする場合は,その値を取得しておきます.この時間は以下のコードで取得できます.


図23
[通知を表示する長さ] の値を取得
  • 最小値は 5 秒でデフォルト値

//=============================================================================
//  システムの [通知を表示する長さ] の設定値を取得 (秒単位)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LValue : DWORD;
  LText  : string;
begin
  SystemParametersInfo(SPI_GETMESSAGEDURATION, 0, @LValue, 0);

  LTExt  := '通知を表示する長さ' + sLineBreak + IntToStr(LValue) + ' 秒';
  MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
end;

//=============================================================================
//  システムの [通知を表示する長さ] を設定 (秒単位)
//  5 秒未満は設定不可
//  5 秒以上であれば任意の値が設定可能
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LValue : DWORD;
begin
  LValue := 15;
  SystemParametersInfo(SPI_SETMESSAGEDURATION, 0, Pointer(LValue), SPIF_UPDATEINIFILE);
end;




07_タスクトレイ ( 通知領域 ) 常駐アプリの履歴削除


バルーンヒントウインドウの設定ボタンで, [・・・すべての通知をオフにする] を選択して,常駐を終了します.再度 EXE を起動してバルーンヒントウィンドウを表示しようとしても表示しません.これは,前に常駐アプリとして起動したプログラムが履歴として残されていて,その設定が有効になっているからです.

サンプルプログラムを終了して (常駐を解除して) 以下のコマンドを実行して,[通知領域] のすぐ下の [タスクバーに表示するアイコンを選択します] をクリックします.タスクバーのアイコン表示がない部分でコンテキストメニュー (マウスの右ボタンクリック) の [タスクバーの設定] でも下図のタスクバーの画面を表示できます.


ms-settings:taskbar


図24
タスクバーの設定

[常にすべてのアイコンを通知領域に表示する] のスイッチをオフにします.オフにしないとアプリの設定スイッチの操作かできません.
対象のアプリのスイッチをオンにします.オンにしたら [常にすべてのアイコンを通知領域に表示する] のスイッチをオンにして設定画面を閉じます.
この操作で,サンプルプログラムの EXE を起動して Button1 をクリックすると,バルーンヒントウィンドウが表示するようになります.


図25
バルーンヒントウ対象アプリのスイッチをオンにする

タスクトレイへ登録したプログラムは,タスクトレイへの登録を解除しても上図のリストに履歴として残ります.元のプログラムが存在しなくなっても,この履歴はなくなりません.タスクトレイにアイコンが表示されていなければ実用的には問題ありませんが,以下に掲載されている方法で,それらの履歴を削除することができます.
筆者は以下のバッチファイルを作成して動作を認しました.IconStreams 項目だけを削除しました.バッチファイルを管理者権限で実行後,上の図の設定を開き直して確認しています.

このバッチファイルを実行しても,上の図の NDIDIA Contanier 等は削除できません.それらは常駐アプリとして登録されていて,(筆者の環境では) タスクトレイにアイコンを表示していないだけです.タスクトレイ (通知領域) に登録されているプログラムは削除できません.



@echo off
setlocal

set KEY=HKEY_CURRENT_USER\Software\Classes\Local Settings\Software\Microsoft\Windows\CurrentVersion\TrayNotify

reg delete "%KEY%" /f /v IconStreams
taskkill /F /IM explorer.exe
start explorer.exe

endloca





08_TBalloonHint のバルーンヒントウィンドウをタスクトレイに表示


TBalloonHint は,バルーンヒントのウィンドウ表示用のコンポーネントです.このバルーンヒントをタスクトレイに表示するサンプルです.表示位置はスクリーン座標で指定します.そこで,本サンプルでは,対象のタスクトレイのアイコンの表示位置を取得する関数を作成して使用しています.

TBalloonHint が表示するバルーンヒントウィンドウには [設定] ボタンも [閉じる] ボタンもありません.見方によっては,それらのボタン操作による誤操作防止になるかも知れません.表示時間は TBalloonHint のプロパティで設定します.
表示幅の制限は,実用的には問題ないと思いますが,あまり長いと右側が表示されないことになります.表示幅を固定したい場合は,TBalloonHint の継承クラスを作成することになります.描画のカスタマイズも,継承クラスを作成すれば可能です.



図26
設定時の画面
  • フォームに以下を配置
    TTrayIcon
    TBalloonHint
    TImageList

EXE を実行して Button1 をクリックすると,下図のようにバルーンヒントウィンドウを表示します.


図27
実行画面
  • 矢印の先端が対象のアイコン
  • 閉じるボタンはない
  • 設定ボタンもない

リスト5
TBalloonHint コンポーネントのバルーンヒントウィンドウをタスクトレイに表示
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.ImgList;

type
  TForm1 = class(TForm)
    Button1: TButton;
    TrayIcon1: TTrayIcon;
    BalloonHint1: TBalloonHint;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  function GetSysTrayIconRect(HintText: string): TRect;

var
  Form1: TForm1;

implementation

uses
  Winapi.CommCtrl;

{$R *.dfm}

type
  TMyBalloonHint = class(TBalloonHint);

//=============================================================================
//  フォーム生成時の処理
// タスク トレイにアイコンを表示する (登録する)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LIcon : TIcon;
begin
  TrayIcon1.Icon   := Application.Icon;
  TrayIcon1.Hint    := 'テストAAA';
  TrayIcon1.Visible := True;

  LIcon := TIcon.Create;
  try
    LIcon.Handle := LoadIcon(0, IDI_INFORMATION);
    ImageList1.Width  := LIcon.Width;
    ImageList1.Height := LIcon.Height;
    ImageList1.AddIcon(LIcon);
  finally
    FreeAndNil(LIcon);
  end;
end;

//=============================================================================
//  フォームを閉じる時の処理
//  タスクトレイへの登録を解除 (タスクトレイのしたアイコンを非表示にする)
//  表示しているバルーンヒントウィンドウも閉じる
//=========================================================================
//====
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  TrayIcon1.Visible := False;
end;

//=============================================================================
//  通知アイコンに TBalloonHint のバルーンヒントウィンドウを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LHintText : string;
  LBtnRect  : TRect;
  LPoint    : TPoint;
begin
  BalloonHint1.Title       := '常駐アプリテスト' + sLineBreak;
  BalloonHint1.Description := 'バルーンヒントウィンドウを表示 ' + sLineBreak
                            + 'TBalloonHint コンポーネントを使用する例  ';
  BalloonHint1.Images     := ImageList1;
  BalloonHint1.ImageIndex := 0;
  BalloonHint1.HideAfter := 10000;


  // タスクトレイ (通知領域) のアイコンの表示領域を取得
  // LHintText のデフォルトは Project1
  if TrayIcon1.Hint = '' then begin
    LHintText := ChangeFileExt(ExtractFileName(Application.ExeName), '');
  end else begin
    LHintText := TrayIcon1.Hint;
  end;
  LBtnRect := GetSysTrayIconRect(LHintText);

  // 表示位置を指定してバルーンヒントウィンドウを表示
  LPoint.X := LBtnRect.Left + (LBtnRect.Right -+ LBtnRect.Left) div 2;
  LPoint.Y := LBtnRect.Top + 5;
  TMyBalloonHint(BalloonHint1).showHint(LPoint);
end;


//-----------------------------------------------------------------------------
//  タスクトレイのウィンドウハンドルを取得する関数
//-----------------------------------------------------------------------------
function GetSysTrayWnd: HWND;
begin
  Result := FindWindow('Shell_TrayWnd', nil);
  Result := FindWindowEx(Result, 0, 'TrayNotifyWnd', nil);
  Result := FindWindowEx(Result, 0, 'SysPager', nil);
  Result := FindWindowEx(Result, 0, 'ToolbarWindow32', nil);
end;

//-----------------------------------------------------------------------------
//  タスクトレイ (通知領域) のアイコンの表示位置を取得
//  戻り値は TRect レコード型.値はスクリーン座標における値
//  取得操作は共有メモリを利用
//
//  TaskTrayWnd : タスクトレイのウィンドウハンドルの値
//  AHintText   : 通知領域のアイコンのヒントテキスト
//
//  uses に Winapi.CommCtrl が必要
//-----------------------------------------------------------------------------
function GetToolBarButtonRect(TaskTrayWnd: HWND; HintText: string): TRect;
var
   LBtnInfo   : _TBBUTTON;
   LBuffer    : PChar;
   LHintChars : array [0..1023] of Char;
   LProcessID : THandle;
   LhProcess  : THandle;
   LByteSize  : NativeUInt;
   LIsHide    : Boolean;
   LCount     : Integer;
   LIndex     : Integer;
begin
  FillChar(Result, SizeOf(Result), 0);
  if TaskTrayWnd = 0 then Exit;

  GetWindowThreadProcessId(TaskTrayWnd, @LProcessID);
  LhProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE,
                           False,
                           LProcessID);
  LBuffer := VirtualAllocEx(LhProcess,
                            nil,
                            4096,
                            MEM_RESERVE or MEM_COMMIT,
                            PAGE_READWRITE);

  LCount := SendMessage(TaskTrayWnd, TB_BUTTONCOUNT, 0, 0);
  for LIndex := 0 to LCount - 1 do begin
    FillChar(LBtnInfo, SizeOf(LBtnInfo), 0);
    WriteProcessMemory(LhProcess, LBuffer, @LBtnInfo, SizeOf(LBtnInfo), LByteSize);

    SendMessage(TaskTrayWnd, TB_GETBUTTON, LIndex, Integer(LBuffer));
    ReadProcessMemory(LhProcess, LBuffer, @LBtnInfo, SizeOf(LBtnInfo), LByteSize);

    SendMessage(TaskTrayWnd,
                TB_GETBUTTONTEXT,
                LBtnInfo.idCommand,
                NativeInt(Integer(@LBuffer[0]) + SizeOf(LBtnInfo)));
    ReadProcessMemory(LhProcess,
                      Pointer(Integer(@LBuffer[0]) + SizeOf(LBtnInfo)),
                      @LHintChars[0],
                      SizeOf(LHintChars),
                      LByteSize);

    LIsHide :=  Boolean(SendMessage(TaskTrayWnd,
                                    TB_ISBUTTONHIDDEN,
                                    LBtnInfo.idCommand,
                                    0));
    if SameText(StrPas(LHintChars), HintText) and not LIsHide then begin
      SendMessage(TaskTrayWnd,
                  TB_GETRECT,
                  LBtnInfo.idCommand,
                  Integer(Integer(@LBuffer[0]) + SizeOf(LBtnInfo)));
      ReadProcessMemory(LhProcess,
                        Pointer(Integer(@LBuffer[0]) + SizeOf(LBtnInfo)),
                        @Result,
                        SizeOf(Result),
                        LByteSize);

      ClientToScreen(TaskTrayWnd, Result.TopLeft);
      ClientToScreen(TaskTrayWnd, Result.BottomRight);
      Break;
    end;
   end;

   VirtualFreeEx(LhProcess, LBuffer, 0, MEM_RELEASE);
   CloseHandle(LhProcess);
end;

//-----------------------------------------------------------------------------
//  タスクトレイ (通知領域) のアイコンの表示位置を取得
//  戻り値は TRect レコード型.値はスクリーン座標における値
//  引数はヒントのテキスト (ツールチップのテキスト)
//-----------------------------------------------------------------------------
function GetSysTrayIconRect(HintText: string): TRect;
begin
  Result := GetToolBarButtonRect(GetSysTrayWnd, HintText);
end;

end.




09_閉じるボタン付きバルーンヒントウィンドウをタスクトレイに表示


閉じるボタン付きのバルーンヒントウィンドウをタスクトレイのすぐ上に表示するサンプルです.


図28
設定時の画面
  • フォームに以下を配置
    TTrayIcon
    TTimer

閉じるボタン付きのバルーンヒントウィンドウのコードは,以下のリンクの記事に掲載しているサンプルコードを変更して使用しています.TToolInfo.uFlags に TTF_TRACK を含めて  TTF_CENTERTIP は除外しています.フラグに TTF_TRACK がある場合,表示位置の指定には TTM_TRACKPOSITION メッセージを使用します.TToolInfo.Rect の値は使用しません.

    SendMessage(FhWndTip, TTM_TRACKPOSITION, 0, MakeLParam(APos.X, APos.Y));


図29
実行画面

リスト6
閉じるボタン付きバルーンヒントウィンドウをタスクトレイに表示
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    TrayIcon1: TTrayIcon;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  procedure ShowBalloonTip(APos: TPoint; Icon: HICON; const Title, Text: string);
  function GetSysTrayIconRect(HintText: string): TRect;

var
  Form1: TForm1;

implementation

uses
  Winapi.CommCtrl;

{$R *.dfm}

var
  FhWndTip : THandle;

//=============================================================================
// タスク トレイにアイコンを表示する (登録する)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  TrayIcon1.Icon   := Application.Icon;
  TrayIcon1.Hint    := 'テスト Balloon';
  TrayIcon1.Visible := True;
end;

//=============================================================================
//  フォームを閉じる時の処理
//  タスクトレイへの登録を解除 (タスクトレイのしたアイコンを非表示にする)
//  表示しているバルーンヒントウィンドウも閉じる
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  TrayIcon1.Visible := False;
end;

//=============================================================================
//  閉じるボタン付きのバルーンヒントを表示
//  タイマーを使用して一定時間経過したら閉じる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LTitle    : string;
  LText     : string;
  LhIcon    : HICON;
  LHintText : string;
  LBtnRect  : TRect;
  LPos     : TPoint;
begin
  Timer1.Enabled := False;

  LhIcon := LoadIcon(0, IDI_INFORMATION);
  try
    LTitle :=  '常駐アプリテスト';
    LText  := sLineBreak + 'バルーンヒントウィンドウを表示     ' + sLineBreak
            + '自作バルーンヒントウィンドウの例';

    // タスクトレイ (通知領域) のアイコンの表示領域を取得
    // LHintText のデフォルトは Project1
    if TrayIcon1.Hint = '' then begin
      LHintText := ChangeFileExt(ExtractFileName(Application.ExeName), '');
    end else begin
      LHintText := TrayIcon1.Hint;
    end;
    LBtnRect := GetSysTrayIconRect(LHintText);

    LPos.X := LBtnRect.Left + (LBtnRect.Right -+ LBtnRect.Left) div 2;
    LPos.Y := LBtnRect.Top + 5;
    ShowBalloonTip(LPos, LhIcon, LTitle, LText);
  finally
    DestroyIcon(LhIcon);
  end;

  Timer1.Interval := 12000;
  Timer1.Enabled  := True;
end;

//=============================================================================
//  一定時間経過したらバルーンヒントを閉じる
//=============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if FhWndTip <> 0 then begin
    PostMessage(FhWndTip, WM_CLOSE, 0, 0);
    FhWndTip := 0;
    Timer1.Enabled := False;
  end;
end;

//-----------------------------------------------------------------------------
//  閉じるボタン付きバルーンヒントを表示する手続き
//  TToolInfo.uFlags に TTF_TRACK を含めて表示位置をスクリーン座標で指定
//  TTF_CENTERTIP を含めとと矢印が中央になる
//  この場合,表示位置は TTM_TRACKPOSITION メッセージで指定する.
//
//  フォントサイズ変更
//  変更可能なのは説明用テキストのみ
//  色関係の設定は実行しても無効
//
//  Text が複数行の場合,2 行目以降が長いと全てが表示されない場合がある
//  1 行目の文字列またはタイトルの文字列に全角の空白文字を追加すると回避できる
//-----------------------------------------------------------------------------
procedure ShowBalloonTip(APos: TPoint; Icon: HICON; const Title, Text: string);
var
  LWndFlag  : Cardinal;
  LToolInfo : TToolInfo;
  LFont     : TFont;
begin
  if FhWndTip <> 0 then begin
    PostMessage(FhWndTip, WM_CLOSE, 0, 0);
    FhWndTip := 0;
  end;

  LWndFlag := WS_POPUP or TTS_CLOSE or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP;
  FhWndTip := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil, LWndFlag,
                             0, 0, 0, 0, 0, 0, HInstance, nil);
  if FhWndTip = 0 then Exit;

  LFont := TFont.Create;
  try
    // フォントサイズ変更
    LFont.Size  := 11;
    LFont.Style := [fsBold];
    SendMessage(FhWndTip, WM_SETFONT, LFont.Handle, 0);

    LToolInfo.cbSize   := SizeOf(TToolInfo);
    LToolInfo.uFlags   := TTF_TRANSPARENT or TTF_SUBCLASS or TTF_TRACK;
    LToolInfo.hWnd     := 0;
    LToolInfo.hInst    := HInstance;
    LToolInfo.lpszText := PChar(Text);

    SendMessage(FhWndTip, TTM_ADDTOOL, 0, integer(@LToolInfo));
    SendMessage(FhWndTip, TTM_SETTITLE, WPARAM(Icon), LPARAM(PChar(Title)));
    SendMessage(FhWndTip, TTM_TRACKPOSITION, 0, MakeLParam(APos.X, APos.Y));
    SendMessage(FhWndTip, TTM_TRACKACTIVATE, 1, LPARAM(@LToolInfo));
  finally
    FreeAndNil(LFont);
  end;
end;


//-----------------------------------------------------------------------------
//  タスクトレイのウィンドウハンドルを取得する関数
//-----------------------------------------------------------------------------
function GetSysTrayWnd: HWND;
begin
  Result := FindWindow('Shell_TrayWnd', nil);
  Result := FindWindowEx(Result, 0, 'TrayNotifyWnd', nil);
  Result := FindWindowEx(Result, 0, 'SysPager', nil);
  Result := FindWindowEx(Result, 0, 'ToolbarWindow32', nil);
end;

//-----------------------------------------------------------------------------
//  タスクトレイ (通知領域) のアイコンの表示位置を取得
//  戻り値は TRect レコード型.値はスクリーン座標における値
//  取得操作は共有メモリを利用
//
//  TaskTrayWnd : タスクトレイのウィンドウハンドルの値
//  AHintText   : 通知領域のアイコンのヒントテキスト
//
//  uses に Winapi.CommCtrl が必要
//-----------------------------------------------------------------------------
function GetToolBarButtonRect(TaskTrayWnd: HWND; HintText: string): TRect;
var
   LBtnInfo   : _TBBUTTON;
   LBuffer    : PChar;
   LHintChars : array [0..1023] of Char;
   LProcessID : THandle;
   LhProcess  : THandle;
   LByteSize  : NativeUInt;
   LIsHide    : Boolean;
   LCount     : Integer;
   LIndex     : Integer;
begin
  FillChar(Result, SizeOf(Result), 0);
  if TaskTrayWnd = 0 then Exit;

  GetWindowThreadProcessId(TaskTrayWnd, @LProcessID);
  LhProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE,
                           False,
                           LProcessID);
  LBuffer := VirtualAllocEx(LhProcess,
                            nil,
                            4096,
                            MEM_RESERVE or MEM_COMMIT,
                            PAGE_READWRITE);

  LCount := SendMessage(TaskTrayWnd, TB_BUTTONCOUNT, 0, 0);
  for LIndex := 0 to LCount - 1 do begin
    FillChar(LBtnInfo, SizeOf(LBtnInfo), 0);
    WriteProcessMemory(LhProcess, LBuffer, @LBtnInfo, SizeOf(LBtnInfo), LByteSize);

    SendMessage(TaskTrayWnd, TB_GETBUTTON, LIndex, Integer(LBuffer));
    ReadProcessMemory(LhProcess, LBuffer, @LBtnInfo, SizeOf(LBtnInfo), LByteSize);

    SendMessage(TaskTrayWnd,
                TB_GETBUTTONTEXT,
                LBtnInfo.idCommand,
                NativeInt(Integer(@LBuffer[0]) + SizeOf(LBtnInfo)));
    ReadProcessMemory(LhProcess,
                      Pointer(Integer(@LBuffer[0]) + SizeOf(LBtnInfo)),
                      @LHintChars[0],
                      SizeOf(LHintChars),
                      LByteSize);

    LIsHide :=  Boolean(SendMessage(TaskTrayWnd,
                                    TB_ISBUTTONHIDDEN,
                                    LBtnInfo.idCommand,
                                    0));
    if SameText(StrPas(LHintChars), HintText) and not LIsHide then begin
      SendMessage(TaskTrayWnd,
                  TB_GETRECT,
                  LBtnInfo.idCommand,
                  Integer(Integer(@LBuffer[0]) + SizeOf(LBtnInfo)));
      ReadProcessMemory(LhProcess,
                        Pointer(Integer(@LBuffer[0]) + SizeOf(LBtnInfo)),
                        @Result,
                        SizeOf(Result),
                        LByteSize);

      ClientToScreen(TaskTrayWnd, Result.TopLeft);
      ClientToScreen(TaskTrayWnd, Result.BottomRight);
      Break;
    end;
   end;

   VirtualFreeEx(LhProcess, LBuffer, 0, MEM_RELEASE);
   CloseHandle(LhProcess);
end;

//-----------------------------------------------------------------------------
//  タスクトレイ (通知領域) のアイコンの表示位置を取得
//  戻り値は TRect レコード型.値はスクリーン座標における値
//  引数はヒントのテキスト (ツールチップのテキスト)
//-----------------------------------------------------------------------------
function GetSysTrayIconRect(HintText: string): TRect;
begin
  Result := GetToolBarButtonRect(GetSysTrayWnd, HintText);
end;

end.