【Delphi】タスクバーアイコンに進捗を表示する

はじめに

エクスプローラーでファイルをコピーするとタスクバーのアイコンに進捗ゲージが表示されると思うのですが、これを Delphi 製アプリに実装してみたいと思います。

正式名称は「プログレスインジケーター (進行状況バー)」のようですね。Windows 7 から使えます。

• タスクバー (Microsoft)

実装

最近の Delphi だと特に難しい事はないです。Winapi.ShlObj を uses に追加すれば ITaskbarList3 が使えます。

プログレスインジケーターを簡単に使えるようにするため、高度なレコード型で実装してみたいと思います。

ソースコード

以下、ソースコードです。

uTaskbarProgress.pas

unit uTaskbarProgress;

interface

uses
  Winapi.Windows, Winapi.Messages, Winapi.ShlObj, System.Win.ComObj,
  System.SysUtils, System.Classes, System.SyncObjs;

type
  TTaskbarProgress = record
  private
    FHWnd: HWND;
    FState: DWORD;
    FValue: UInt64;
    FMax: UInt64;
    procedure ApplyToTaskbar(const aState: DWORD; const aValue, aMax: UInt64);
  public
    class function Create(AHWnd: HWND): TTaskbarProgress; static;
    procedure Clear;
    procedure SetError;
    procedure SetIndeterminate;
    procedure SetMax(aMax: UInt64);
    procedure SetPaused;
    procedure SetState(aState: DWORD);
    procedure SetValue(aValue: UInt64);
    procedure Update(aValue, aMax: UInt64; aState: DWORD = TBPF_NORMAL);
  end;

implementation

{ TTaskbarProgress }

class function TTaskbarProgress.Create(aHWnd: HWND): TTaskbarProgress;
begin
  Result.FHWnd := aHWnd;
  Result.FState := TBPF_NOPROGRESS;
  Result.FValue := 0;
  Result.FMax := 100;
end;

procedure TTaskbarProgress.SetError;
begin
  SetState(TBPF_ERROR);
end;

procedure TTaskbarProgress.SetIndeterminate;
begin
  SetState(TBPF_INDETERMINATE);
end;

procedure TTaskbarProgress.SetPaused;
begin
  SetState(TBPF_PAUSED);
end;

procedure TTaskbarProgress.ApplyToTaskbar(const aState: DWORD; const aValue, aMax: UInt64);
begin
  var lHWnd := FHWnd;
  if lHWnd = 0 then
    Exit;
  TThread.Queue(nil,
    procedure
    begin
      try
        var TaskbarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList3;
        if TaskbarList <> nil then
        begin
          TaskbarList.SetProgressState(lHWnd, aState);
          if (aState <> TBPF_NOPROGRESS) and (aState <> TBPF_INDETERMINATE) then
            TaskbarList.SetProgressValue(lHWnd, aValue, aMax);
        end;
      except
      end;
    end);
end;

procedure TTaskbarProgress.Update(aValue, aMax: UInt64; aState: DWORD);
begin
  if (FState = aState) and (FValue = aValue) and (FMax = aMax) then
    Exit;
  FState := aState;
  FValue := aValue;
  FMax := aMax;
  ApplyToTaskbar(aState, aValue, aMax);
end;

procedure TTaskbarProgress.SetMax(aMax: UInt64);
begin
  Update(FValue, aMax, FState);
end;

procedure TTaskbarProgress.SetState(aState: DWORD);
begin
  Update(FValue, FMax, aState);
end;

procedure TTaskbarProgress.SetValue(aValue: UInt64);
begin
  Update(aValue, FMax, TBPF_NORMAL);
end;

procedure TTaskbarProgress.Clear;
begin
  Update(0, 100, TBPF_NOPROGRESS);
end;

end.

使い方

こんな感じになります。

uses
  ..., uTaskbarProgress;

procedure TForm1.Button1Click(Sender: TObject);
begin
  var TaskbarProgress := TTaskbarProgress.Create(Self.Handle);
  try
    TaskbarProgress.Clear;         // 進捗を初期化
    for var i := 1 to 100 do
    begin
      TaskbarProgress.SetValue(i); // 進捗を更新
      Sleep(50);
      Application.ProcessMessages;
    end;
  finally
    TaskbarProgress.Clear;         // 進捗を初期化 (元に戻す)
  end;
end;

途中で進捗の状態を変えたい時には次のメソッドを使ってください。

アイコン	定数	メソッド	説明
	TBPF_NOPROGRESS	Clear()	進捗表示なし (アクティブ)
	TBPF_INDETERMINATE	SetIndeterminate()	処理中＆マーキー表示 (進捗不明)
	TBPF_NORMAL	SetValue()	処理中＆進捗表示
	TBPF_PAUSED	SetPaused()	中断中＆再開待ち
	TBPF_ERROR	SetError()	中断中＆再開不能

Windows 11 だと進捗状態によってアイコン全体の色は変化しないので、どの状態にあるのかが少し判りにくいです。Windows 10 までは全体の色が変わっていました。

逆に Windows 10 以前だと進捗 100% ＆ TBPF_ERROR の指定でタスクバーアイコンを悪目立ちさせるハックが...進捗を 0% -> 100% -> 0% -> 100%... と繰り返すだけで点滅します (うわウザい！)

SetState() メソッドでも状態は変更できますが、TBPF_～ 定数を使う事になるので、Winapi.ShlObj を uses に追加する必要があります。

おわりに

...まぁ、何番煎じだって話ではあるのですが。

See also:

• 712_タスクバーへの追加・削除とプログレス表示 (Mr.XRAY)
• Windows 7のタスクバーの制御 (Owl's perspective)