Как добавить кнопки миниатюр на панель задач в Delphi с использованием ITaskbarList3

Delphi , Рабочий стол , TaskBar

Решение проблемы с THUMBBUTTON в 64-битном Lazarus (FPC) при работе с ITaskbarList3

Введение

При добавлении кнопок миниатюр (thumb buttons) на панель задач Windows разработчики на Delphi и Lazarus часто используют интерфейс ITaskbarList3. Однако при переходе на 64-битную версию Lazarus (FPC) могут возникнуть проблемы, связанные с различиями в структуре данных THUMBBUTTON. В этой статье разберем решение проблемы и приведем рабочий пример кода.

Проблема

Исходный код, работающий в Delphi (32/64-bit) и Lazarus 32-bit, перестает функционировать в Lazarus 64-bit.
Симптомы:
- Кнопки не отображаются на панели задач.
- Ошибки в структуре данных THUMBBUTTON.

Причина: В FPC для 64-битных приложений структура THUMBBUTTON определена с модификатором packed, что приводит к неправильному выравниванию данных при вызове Windows API.

Решение от ASerge

Для корректной работы в 64-битном Lazarus необходимо:
1. Убрать packed из определения THUMBBUTTON.
2. Исправить получение интерфейса ITaskbarList3.

Шаг 1. Переопределение структуры THUMBBUTTON

Замените стандартное определение структуры в вашем коде:

type
  THUMBBUTTON = record
    dwMask: DWORD;
    iId: UINT;
    iBitmap: UINT;
    hIcon: HICON;
    szTip: array [0..259] of WideChar;
    dwFlags: DWORD;
  end;

Важно: Убедитесь, что модификатор packed отсутствует.

Шаг 2. Исправление инициализации интерфейса

Используйте Supports без повторного вызова CreateComObject:

// Было (ошибка):
if (Supports(FTaskbarList, ITaskbarList3, FTaskbarList3)) then 
begin
  FTaskbarList3 := CreateComObject(CLSID_TaskbarList) as ITaskbarList3; // Неверно!
end;

// Стало (правильно):
FTaskbarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList;
FTaskbarList.HrInit;
if not Supports(FTaskbarList, ITaskbarList3, FTaskbarList3) then
  FTaskbarList3 := nil;

Рабочий пример кода

uses
  Windows, ShlObj, ComObj;

type
  TFormMain = class(TForm)
    // ... ваши компоненты ...
  private
    FTaskbarList: ITaskbarList;
    FTaskbarList3: ITaskbarList3;
    procedure PrcThumbButtons;
  end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  if CheckWin32Version(6, 1) then // Проверка на Windows 7+
  begin
    FTaskbarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList;
    FTaskbarList.HrInit;
    if not Supports(FTaskbarList, ITaskbarList3, FTaskbarList3) then
      FTaskbarList3 := nil;
  end;
end;

procedure TFormMain.PrcThumbButtons;
var
  Buttons: array[1..2] of THUMBBUTTON;
begin
  // Инициализация кнопок
  Buttons[1].iId := 41;
  Buttons[1].dwFlags := THBF_ENABLED;
  Buttons[1].iBitmap := 0;
  StrLCopy(Buttons[1].szTip, 'Prior', Length(Buttons[1].szTip));

  Buttons[2].iId := 42;
  Buttons[2].dwFlags := THBF_ENABLED;
  Buttons[2].iBitmap := 2;
  StrLCopy(Buttons[2].szTip, 'Next', Length(Buttons[2].szTip));

  // Для Lazarus 64-bit используйте Pointer(@Buttons[1])
  FTaskbarList3.ThumbBarAddButtons(Application.Handle, Length(Buttons), @Buttons[1]);
end;

Обработка кликов по кнопкам

Для реакции на нажатия используйте подклассирование окна (рекомендовано ASerge):

// В объявлении формы:
public
  procedure PrcThumbButtonClick(PrmId: Integer);

// Обработчик сообщений
function AppSubClassProc(Wnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM;
  uISubClass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
var
  Form: TFormMain absolute dwRefData;
begin
  if (Msg = WM_COMMAND) and (HIWORD(WParam) = THBN_CLICKED) then
    Form.PrcThumbButtonClick(LOWORD(WParam));
  Result := DefSubclassProc(Wnd, Msg, WParam, LParam);
end;

// Установка подкласса в FormShow
procedure TFormMain.FormShow(Sender: TObject);
begin
  SetWindowSubclass(Application.Handle, @AppSubClassProc, 1, DWORD_PTR(Self));
end;

procedure TFormMain.PrcThumbButtonClick(PrmId: Integer);
begin
  case PrmId of
    41: ShowMessage('Кнопка "Prior" нажата');
    42: ShowMessage('Кнопка "Next" нажата');
  end;
end;

Альтернативное решение

Если модификация структуры нежелательна, можно использовать динамическое создание кнопок через CoTaskMemAlloc:

var
  Buttons: LPTHUMBBUTTON;
begin
  Buttons := CoTaskMemAlloc(SizeOf(THUMBBUTTON) * 2);
  try
    // Заполнение Buttons[0] и Buttons[1]...
    FTaskbarList3.ThumbBarAddButtons(Application.Handle, 2, Buttons);
  finally
    CoTaskMemFree(Buttons);
  end;
end;

Заключение

Проблема с THUMBBUTTON в 64-битном Lazarus решается:
1. Корректным определением структуры без packed.
2. Правильной инициализацией COM-интерфейсов.
3. Использованием безопасных методов обработки сообщений.

Ошибка зарегистрирована в баг-трекере FPC как Issue 41333.
Для проектов на Delphi и Lazarus всегда проверяйте:
- Размерности структур.
- Правильность получения интерфейсов.
- Обработку сообщений в 64-битных средах.

Пример проекта можно скачать здесь (адаптирован для Delphi и Lazarus).

Создано по материалам из источника по ссылке.

Проблема некорректного отображения кнопок миниатюр в 64-битном Lazarus из-за неправильного выравнивания структуры THUMBBUTTON при использовании ITaskbarList3.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TaskBar ::