【Delphi】タスクバーサムネイルを表示する

はじめに

タスクバーサムネイルはタスクバーボタンへマウスオーバーした時に表示されます。さらにサムネイルへマウスオーバーするとライブプレビュー (Aero Peek) が表示されます。

タスクバーサムネイルおよびライブプレビューは特に何もしなくても表示されます。TForm が基本的な事はやってくれるからです。

タスクバーサムネイルおよびライブプレビュー機能は Windows Vista から使えます。

複数のサムネイルを表示できる タスクバーサムネイル (タブ) については以下のような事をしたい場合があるかと思います。

• 別フォームをそれぞれプレビューしたい
• MDI の子ウインドウをそれぞれプレビューしたい
• タブをそれぞれプレビューしたい
• サムネイルツールバーと合わせてミニプレーヤー的な使い方をしたい

タスクバーサムネイル (タブ) は Windows 7 から使えます。

• タスクバー (Microsoft)

実装

タスクバーサムネイル (タブ) も最近の Delphi だと特に難しい事はないです。Winapi.ShlObj を uses に追加すれば ITaskbarList4 が使えます。

タスクバーサムネイル (タブ) を簡単に使えるようにするため、クラスで実装してみたいと思います。

ソースコード

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

本ユニットはメインスレッドで COM が初期化されている前提（通常の VCL / FMX アプリ）で動作します。必要であればアプリケーション側で CoInitialize() / CoUninitialize() を記述してください。

Win.Taskbar.TaskbarThumbnail.pas

unit Win.Taskbar.TaskbarThumbnail;

interface

uses
  System.SysUtils, System.Classes, System.Types, Winapi.Windows, Winapi.Messages,
  Winapi.DwmApi, Winapi.ShlObj, Winapi.ActiveX;

type
  TTaskbarThumbnail = class
  private
    FMainFormHandle: HWND;
    FTaskbarList: ITaskbarList4;
    function GetTaskbar: ITaskbarList4;
  public
    constructor Create(aMainFormHandle: HWND);
    destructor Destroy; override;
    procedure ApplyTabsChanges(aTabHandle: HWND);
    procedure RegisterTab(aTabHandle: HWND; UseCustomPreview: Boolean = False);
    procedure SetTabActive(aTabHandle: HWND);
    procedure SetTabOrder(aTabHandle, aTabInsertBefore: HWND);
    procedure SetTabProperties(aTabHandle: HWND; aFlags: STPFLAG);
    procedure UnregisterTab(aTabHandle: HWND);
  end;

implementation

{ TTaskbarThumbnail }

constructor TTaskbarThumbnail.Create(aMainFormHandle: HWND);
begin
  inherited Create;
  FMainFormHandle := aMainFormHandle;
end;

destructor TTaskbarThumbnail.Destroy;
begin
  FTaskbarList := nil;
  inherited Destroy;
end;

procedure TTaskbarThumbnail.ApplyTabsChanges(aTabHandle: HWND);
begin
  DwmInvalidateIconicBitmaps(aTabHandle);
end;

function TTaskbarThumbnail.GetTaskbar: ITaskbarList4;
begin
  if FTaskbarList = nil then
    if Succeeded(CoCreateInstance(CLSID_TaskbarList, nil, CLSCTX_INPROC_SERVER, ITaskbarList4, FTaskbarList)) then
      if FTaskbarList <> nil then
        FTaskbarList.HrInit;
  Result := FTaskbarList;
end;

procedure TTaskbarThumbnail.RegisterTab(aTabHandle: HWND; UseCustomPreview: Boolean);
begin
  if (aTabHandle = 0) or not IsWindow(aTabHandle) then
    Exit;
  if aTabHandle <> FMainFormHandle then
  begin
    var lTaskbar := GetTaskbar;
    if lTaskbar = nil then
      Exit;
    lTaskbar.RegisterTab(aTabHandle, FMainFormHandle);
  end;
  SetTabProperties(aTabHandle, STPF_NONE);
  var lEnabled: LongBool := UseCustomPreview;
  {$WARN SYMBOL_PLATFORM OFF}
  var HR: HRESULT;
  HR := DwmSetWindowAttribute(aTabHandle, DWMWA_HAS_ICONIC_BITMAP, @lEnabled, SizeOf(lEnabled));
  Win32Check(Succeeded(HR));
  HR := DwmSetWindowAttribute(aTabHandle, DWMWA_FORCE_ICONIC_REPRESENTATION, @lEnabled, SizeOf(lEnabled));
  Win32Check(Succeeded(HR));
  {$WARN SYMBOL_PLATFORM ON}
  DwmInvalidateIconicBitmaps(aTabHandle);
end;

procedure TTaskbarThumbnail.UnregisterTab(aTabHandle: HWND);
begin
  if aTabHandle = 0 then
    Exit;
  if aTabHandle = FMainFormHandle then
    Exit;
  var lTaskbar := GetTaskbar;
  if lTaskbar <> nil then
    lTaskbar.UnregisterTab(aTabHandle);
end;

procedure TTaskbarThumbnail.SetTabActive(aTabHandle: HWND);
begin
  if (aTabHandle = 0) or not IsWindow(aTabHandle) then
    Exit;
  var lTaskbar := GetTaskbar;
  if lTaskbar <> nil then
    lTaskbar.SetTabActive(aTabHandle, FMainFormHandle, 0);
end;

procedure TTaskbarThumbnail.SetTabOrder(aTabHandle, aTabInsertBefore: HWND);
begin
  if (aTabHandle = 0) or not IsWindow(aTabHandle) then
    Exit;
  var lTaskbar := GetTaskbar;
  if lTaskbar <> nil then
    lTaskbar.SetTabOrder(aTabHandle, aTabInsertBefore);
end;

procedure TTaskbarThumbnail.SetTabProperties(aTabHandle: HWND; aFlags: STPFLAG);
begin
  if (aTabHandle = 0) or not IsWindow(aTabHandle) then
    Exit;
  var lTaskbar := GetTaskbar;
  if lTaskbar <> nil then
    lTaskbar.SetTabProperties(aTabHandle, aFlags);
end;
end.

使い方

Win.Taskbar.TaskbarThumbnail の使い方です。

・'タブ'（フォーム）を登録してタスクバー プレビューに複数の画像を表示する

RegisterTab() でフォームのハンドルを登録します。登録されたフォームはサムネイル表示されます。

uses
  ..., Win.Taskbar.TaskbarThumbnail;

...

  private
    { Private 宣言 }
    FTaskbarThumbnail: TTaskbarThumbnail;

...


procedure TForm1.FormCreate(Sender: TObject);
begin
  TThread.ForceQueue(nil,
    procedure
    begin
      FTaskbarThumbnail := TTaskbarThumbnail.Create(Self.Handle);
      // Form2 をタブに追加
      Form2.Show;
      FTaskbarThumbnail.RegisterTab(Form2.Handle);
      FTaskbarThumbnail.ApplyTabsChanges(Form2.Handle);
      // Form3 をタブに追加
      Form3.Show;
      FTaskbarThumbnail.RegisterTab(Form3.Handle);
      FTaskbarThumbnail.ApplyTabsChanges(Form3.Handle);
    end);
end;

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

・新しい画像を生成して表示

サムネイルのカスタマイズ描画です。ミニプレイヤー等を作るのに使えます。

RegisterTab() の第二パラメータ (UseCustomPreview) に True を設定すると、第一パラメータ (aTabHandle) で指定したウインドウハンドルに対して WM_DWMSENDICONICTHUMBNAIL メッセージと WM_DWMSENDICONICLIVEPREVIEWBITMAP メッセージが飛んできます。

サンプルではサムネイル / ライブプレビューともにクライアント領域を描画しています。PaintTo の部分をお好きな描画処理に差し替えてください。

uses
  ..., System.Math, Win.Taskbar.TaskbarThumbnail;

...

  private
    { Private 宣言 }
    FTaskbarThumbnail: TTaskbarThumbnail;
    procedure WMDwmSendIconicThumbnail(var Msg: TMessage); message WM_DWMSENDICONICTHUMBNAIL;
    procedure WMDwmSendIconicLivePreviewBitmap(var Msg: TMessage); message WM_DWMSENDICONICLIVEPREVIEWBITMAP;
...


procedure TForm1.FormCreate(Sender: TObject);
begin
  TThread.ForceQueue(nil,
    procedure
    begin
      FTaskbarThumbnail := TTaskbarThumbnail.Create(Self.Handle);
      // メインフォームを追加
      FTaskbarThumbnail.RegisterTab(Form1.Handle, True); // カスタム描画
      FTaskbarThumbnail.ApplyTabsChanges(Form1.Handle);
    end);
end;

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

// ライブプレビューの独自描画
procedure TForm1.WMDwmSendIconicLivePreviewBitmap(var Msg: TMessage);
begin
  var lBmp := TBitmap.Create;
  try
    lBmp.SetSize(ClientWidth, ClientHeight);
    lBmp.PixelFormat := pf24bit;

    // 描画処理
    Self.PaintTo(lBmp.Canvas, 0, 0); // 自分自身のクライアント領域
    lBmp.PixelFormat := pf32bit;

    // ライブプレビュー画像の登録
    DwmSetIconicLivePreviewBitmap(Self.Handle, lBmp.Handle, nil, 0);
  finally
    lBmp.Free;
  end;
  Msg.Result := 0;
end;

// サムネイルの独自描画
procedure TForm1.WMDwmSendIconicThumbnail(var Msg: TMessage);
begin
  var lMaxH := HIWORD(Msg.LParam);
  var lMaxW := LOWORD(Msg.LParam);
  if (Width <= 0) or (Height <= 0) then
    Exit;
  var lBmpSrc := TBitmap.Create;
  try
    lBmpSrc.SetSize(Width, Height);
    lBmpSrc.PixelFormat := pf24bit;

    // 描画処理
    Self.PaintTo(lBmpSrc.Canvas, 0, 0); // 自分自身のクライアント領域
    lBmpSrc.PixelFormat := pf32bit;

    // リサイズ処理
    var lScale := Min(lMaxW / lBmpSrc.Width, lMaxH / lBmpSrc.Height);
    var lDstW := Max(1, Round(lBmpSrc.Width * lScale));
    var lDstH := Max(1, Round(lBmpSrc.Height * lScale));
    var lBmpDst := TBitmap.Create;
    try
      lBmpDst.SetSize(lDstW, lDstH);
      lBmpDst.PixelFormat := pf32bit;
      SetStretchBltMode(lBmpDst.Canvas.Handle, HALFTONE);
      SetBrushOrgEx(lBmpDst.Canvas.Handle, 0, 0, nil);
      StretchBlt(
        lBmpDst.Canvas.Handle, 0, 0, lDstW, lDstH,
        lBmpSrc.Canvas.Handle, 0, 0, lBmpSrc.Width, lBmpSrc.Height,
        SRCCOPY
      );

      // サムネイル画像の登録
      DwmSetIconicThumbnail(Self.Handle, lBmpDst.Handle, 0);
    finally
      lBmpDst.Free;
    end;
  finally
    lBmpSrc.Free;
  end;
  Msg.Result := 0;
end;

注意点

• RegisterTab() したフォームを閉じる場合には、破棄前に UnregisterTab() を呼んでください。メインフォームの場合には呼び出す必要はありません。
• タスクバーサムネイル (タブ) を自前で処理しようとすると、TForm がやっている処理と競合してしまう可能性があります。
• 自前処理は Delphi XE5 以前でないと正しく動作しないかもしれません。XE6 以降には TForm にタスクバーの処理が含まれています。

おわりに

タブの内容をサムネイル表示したい場合にはダミーのウインドウを作ってそこに描画処理を仕込むか、タブにウインドウを埋め込んでください。

FireMonkey フォームも同様で、ダミーのウインドウを作ってそこに描画処理を仕込む必要があるかと思います。

See also:

• 【Delphi】Vcl.Taskbar の使い方
• 【Delphi】System.Win.Taskbar の使い方

索引

[ ↑ 目次へ ]