はじめに
たまにアプリケーションのタスクバーアイコンに小さなアイコンが表示されていると思うのですが、これを Delphi 製アプリに実装してみたいと思います。
正式名称は「サムネイルツールバー」のようですね。Windows 7 から使えます。
実装
最近の Delphi だと特に難しい事はないです。Winapi.ShlObj を uses に追加すれば ITaskbarList3 が使えます。
サムネイルツールバーを簡単に使えるようにするため、クラスで実装してみたいと思います。
ソースコード
以下、ソースコードです。
本ユニットはメインスレッドで COM が初期化されている前提（通常の VCL / FMX アプリ）で動作します。必要であればアプリケーション側で CoInitialize() / CoUninitialize() を記述してください。
Win.Taskbar.ThumbnailToolbar.pas
unit Win.Taskbar.ThumbnailToolbar;
interface
uses
System.SysUtils, Winapi.Windows, Winapi.Messages, Winapi.CommCtrl,
Winapi.ShlObj, Winapi.ActiveX;
type
TThumbnailButtonClickProc = procedure(Sender: TObject; ButtonID: Integer) of object;
TThumbnailToolbar = class
private
FHWnd: HWND;
FTaskbarList: ITaskbarList3;
FOnButtonClick: TThumbnailButtonClickProc;
FOldWndProc: Pointer;
function WndProc(uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
public
constructor Create(aHWnd: HWND);
destructor Destroy; override;
function SetImageList(HIml: HIMAGELIST): Boolean;
function AddButtons(const Buttons: array of THUMBBUTTON): Boolean;
function UpdateButtons(const Buttons: array of THUMBBUTTON): Boolean;
class function CreateButton(aId: UINT; aBitmap: Integer;
const aToolTip: string = ''; aFlags: DWORD = THBF_ENABLED): THUMBBUTTON; overload; static;
class function CreateButton(aId: UINT; aIcon: HICON;
const aToolTip: string = ''; aFlags: DWORD = THBF_ENABLED): THUMBBUTTON; overload; static;
property OnButtonClick: TThumbnailButtonClickProc read FOnButtonClick write FOnButtonClick;
end;
implementation
function SubclassRouter(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
var Obj := TThumbnailToolbar(GetWindowLongPtr(hWnd, GWLP_USERDATA));
if Assigned(Obj) then
Result := Obj.WndProc(uMsg, wParam, lParam)
else
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
constructor TThumbnailToolbar.Create(aHWnd: HWND);
begin
inherited Create;
FHWnd := aHWnd;
FTaskbarList := nil;
if (FHWnd <> 0) then
begin
SetWindowLongPtr(FHWnd, GWLP_USERDATA, LONG_PTR(Self));
FOldWndProc := Pointer(SetWindowLongPtr(FHWnd, GWLP_WNDPROC, LONG_PTR(@SubclassRouter)));
end;
if Succeeded(CoCreateInstance(CLSID_TaskbarList, nil, CLSCTX_INPROC_SERVER, ITaskbarList3, FTaskbarList)) then
FTaskbarList.HrInit;
end;
destructor TThumbnailToolbar.Destroy;
begin
if (FHWnd <> 0) and Assigned(FOldWndProc) then
begin
SetWindowLongPtr(FHWnd, GWLP_WNDPROC, LONG_PTR(FOldWndProc));
SetWindowLongPtr(FHWnd, GWLP_USERDATA, 0);
end;
FTaskbarList := nil;
inherited Destroy;
end;
function TThumbnailToolbar.WndProc(uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
if uMsg = WM_COMMAND then
begin
var NotifyCode := HIWORD(wParam);
var ButtonID := LOWORD(wParam);
if NotifyCode = THBN_CLICKED then
begin
if Assigned(FOnButtonClick) then
begin
FOnButtonClick(Self, ButtonID);
Exit(0);
end;
end;
end;
Result := CallWindowProc(FOldWndProc, FHWnd, uMsg, wParam, lParam);
end;
function TThumbnailToolbar.SetImageList(HIml: HIMAGELIST): Boolean;
begin
Result := False;
if Assigned(FTaskbarList) and (FHWnd <> 0) then
Result := Succeeded(FTaskbarList.ThumbBarSetImageList(FHWnd, HIml));
end;
function TThumbnailToolbar.AddButtons(const Buttons: array of THUMBBUTTON): Boolean;
begin
Result := False;
if Assigned(FTaskbarList) and (FHWnd <> 0) and (Length(Buttons) > 0) then
Result := Succeeded(FTaskbarList.ThumbBarAddButtons(FHWnd, Length(Buttons), @Buttons[0]));
end;
function TThumbnailToolbar.UpdateButtons(const Buttons: array of THUMBBUTTON): Boolean;
begin
Result := False;
if Assigned(FTaskbarList) and (FHWnd <> 0) and (Length(Buttons) > 0) then
Result := Succeeded(FTaskbarList.ThumbBarUpdateButtons(FHWnd, Length(Buttons), @Buttons[0]));
end;
class function TThumbnailToolbar.CreateButton(aId: UINT; aIcon: HICON;
const aToolTip: string; aFlags: DWORD): THUMBBUTTON;
begin
FillChar(Result, SizeOf(THUMBBUTTON), 0);
Result.dwMask := THB_ICON or THB_TOOLTIP or THB_FLAGS;
Result.iId := aId;
Result.hIcon := aIcon;
Result.dwFlags := aFlags;
if aToolTip <> '' then
StrLCopy(Result.szTip, PChar(aToolTip), Length(Result.szTip) - 1);
end;
class function TThumbnailToolbar.CreateButton(aId: UINT; aBitmap: Integer;
const aToolTip: string; aFlags: DWORD): THUMBBUTTON;
begin
FillChar(Result, SizeOf(THUMBBUTTON), 0);
Result.dwMask := THB_BITMAP or THB_TOOLTIP or THB_FLAGS;
Result.iId := aId;
Result.iBitmap := aBitmap;
Result.dwFlags := aFlags;
if aToolTip <> '' then
StrLCopy(Result.szTip, PChar(aToolTip), Length(Result.szTip) - 1);
end;
end.
使い方
Win.Taskbar.ThumbnailToolbar を uses に追加すれば使えます。
Application.MainFormOnTaskbar が False の場合には、コンストラクタ Create() のパラメータとして Self.Handle ではなく Application.Handle を渡してください。
アイコン形式 (*.ICO) の画像をボタンとして使う
以下はボタンとしてアイコン (*.ICO) 形式のファイルを使う場合です。アイコンはリソースとして EXE に埋め込んであるものとします。
uses
..., Win.Taskbar.ThumbnailToolbar;
...
private
{ Private 宣言 }
FThumbToolbar: TThumbnailToolbar;
procedure HandleThumbButtonClick(Sender: TObject; ButtonID: Integer);
...
rocedure TForm1.FormCreate(Sender: TObject);
begin
TThread.ForceQueue(nil,
procedure
begin
// サムネイルツールバーを作成
FThumbToolbar := TThumbnailToolbar.Create(Self.Handle);
// アイコンの用意
var hIconPrev := LoadIcon(HInstance, 'ICON_REWIND');
var hIconNext := LoadIcon(HInstance, 'ICON_FORWARD');
// サムネイルツールバーにボタンを追加
FThumbToolbar.AddButtons([
TThumbnailToolbar.CreateButton(100, hIconPrev, '前へ'),
TThumbnailToolbar.CreateButton(101, hIconNext, '次へ')
]);
// ボタンを押された時のイベントハンドラ
FThumbToolbar.OnButtonClick := HandleThumbButtonClick;
end);
end;
procedure TForm1.HandleThumbButtonClick(Sender: TObject; ButtonID: Integer);
begin
case ButtonID of
100:
ShowMessage('前へ');
101:
ShowMessage('次へ');
end;
end;
コード例のように ForceQueue() を使って登録処理をメッセージキューの最後に突っ込まないとサムネイルツールバーが表示されないかもしれません。
BITMAP 形式 (*.BMP) の画像をボタンとして使う
以下はボタンとしてビットマップ (*.BMP) 形式のファイルを使う場合です。ビットマップはリソースとして EXE に埋め込んであるものとします。
ビットマップの場合はイメージリストを作成し、リストのインデックスを使ってボタンを登録します。
uses
..., Win.Taskbar.ThumbnailToolbar;
...
private
{ Private 宣言 }
FThumbToolbar: TThumbnailToolbar;
procedure HandleThumbButtonClick(Sender: TObject; ButtonID: Integer);
...
rocedure TForm1.FormCreate(Sender: TObject);
begin
TThread.ForceQueue(nil,
procedure
begin
// サムネイルツールバーを作成
FThumbToolbar := TThumbnailToolbar.Create(Self.Handle);
// Bitmap の用意
var hBmpPrev := LoadBitmap(HInstance, 'BITMAP_LEFT');
var hBmpNext := LoadBitmap(HInstance, 'BITMAP_RIGHT');
// イメージリストの用意
var hImageList := ImageList_Create(16, 16, ILC_COLOR24 or ILC_MASK, 2, 1);
var MaskColor := RGB(255, 0, 255); // 透過色: マゼンタ
ImageList_AddMasked(hImageList, hBmpPrev, MaskColor); // Index: 0
ImageList_AddMasked(hImageList, hBmpNext, MaskColor); // Index: 1
// イメージリストを割り当て
FThumbToolbar.SetImageList(hImageList);
// サムネイルツールバーにボタンを追加
FThumbToolbar.AddButtons([
TThumbnailToolbar.CreateButton(100, 0, '前へ'), // Index: 0
TThumbnailToolbar.CreateButton(101, 1, '次へ') // Index: 1
]);
// ボタンを押された時のイベントハンドラ
FThumbToolbar.OnButtonClick := HandleThumbButtonClick;
end);
end;
procedure TForm1.HandleThumbButtonClick(Sender: TObject; ButtonID: Integer);
begin
case ButtonID of
100:
ShowMessage('前へ');
101:
ShowMessage('次へ');
end;
end;
イメージリストは透過色としてマゼンタを指定していますが、32bit BITMAP (ILC_COLOR32) を使えばアルファチャンネル透過を使うことが出来ます。その際には ImageList_AddMasked() ではなく ImageList_Add() を使って画像をイメージリストに追加してください。
VCL の場合には TImageList を使う事もできます。簡単ですね。
procedure TForm1.FormCreate(Sender: TObject);
begin
TThread.ForceQueue(nil,
procedure
begin
// サムネイルツールバーを作成
FThumbToolbar := TThumbnailToolbar.Create(Self.Handle);
// イメージリストを割り当て
FThumbToolbar.SetImageList(ImageList1.Handle);
// サムネイルツールバーにボタンを追加
FThumbToolbar.AddButtons([
TThumbnailToolbar.CreateButton(100, 0, '前へ'),
TThumbnailToolbar.CreateButton(101, 1, '次へ')
]);
// ボタンを押された時のイベントハンドラ
FThumbToolbar.OnButtonClick := HandleThumbButtonClick;
end);
end;
ICON / BMP ボタンは混在させる事も可能です。
おわりに
ミニプレーヤーみたいな使い方をしたい時ですかね？
See also: