Как использовать API Winapi.Dwmapi.DwmSetWindowAttribute для создания закругленных углов окон в Delphi 2007

unit delphi_rounded_corners;

interface
uses
  Winapi.Windows;

type TRoundedWindowCornerType = (RoundedCornerDefault, RoundedCornerOff, RoundedCornerOn, RoundedCornerSmall);

////////////////////////////////////////////////////////////////////////////
//
// Изначально написано Ианом Баркером
//            https://github.com/checkdigits
//            https://about.me/IanBarker
//            [email protected]
//
// Основано на примере в ответе во время запуска RAD Studio 11 Q & A
//
//
// Бесплатное программное обеспечение - использование для любых целей, включая коммерческое использование.
//
////////////////////////////////////////////////////////////////////////////
//
// Установить или предотвратить закругление углов окна вашего приложения в Windows 11
//
// Использование:
//         SetRoundedCorners(Self.Handle, RoundedCornerSmall);
//
////////////////////////////////////////////////////////////////////////////
///
procedure SetRoundedCorners(const TheHandle: HWND; const CornerType: TRoundedWindowCornerType);

implementation
uses
  Winapi.Dwmapi;

const

  //
  // Дополнительная информация:
  //      https://docs.microsoft.com/en-us/windows/apps/desktop/modernize/apply-rounded-corners
  //      https://docs.microsoft.com/en-us/windows/win32/api/dwmapi/ne-dwmapi-dwmwindowattribute
  //      https://docs.microsoft.com/en-us/windows/win32/api/dwmapi/nf-dwmapi-dwmsetwindowattribute
  //

  DWMWCP_DEFAULT    = 0; // Позволить системе решить, следует ли закруглять углы окна
  DWMWCP_DONOTROUND = 1; // Никогда не закруглять углы окна
  DWMWCP_ROUND      = 2; // Закруглить углы, если это уместно
  DWMWCP_ROUNDSMALL = 3; // Закруглить углы, если это уместно, с небольшим радиусом

  DWMWA_WINDOW_CORNER_PREFERENCE = 33; // [установить] PREFERENCE УГЛА ОКНА, управляет политикой, закругляющей углы верхнего уровня окна

procedure SetRoundedCorners(const TheHandle: HWND; const CornerType: TRoundedWindowCornerType);
var
  DWM_WINDOW_CORNER_PREFERENCE: Cardinal;
begin
  case CornerType of
    RoundedCornerOff:     DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_DONOTROUND;
    RoundedCornerOn:      DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_ROUND;
    RoundedCornerSmall:   DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_ROUNDSMALL;
  else
    DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_DEFAULT;
  end;
  Winapi.Dwmapi.DwmSetWindowAttribute(TheHandle, DWMWA_WINDOW_CORNER_PREFERENCE, @DWM_WINDOW_CORNER_PREFERENCE, sizeof(DWM_WINDOW_CORNER_PREFERENCE));
 end;
end.

Ответ

Чтобы использовать API Winapi.Dwmapi.DwmSetWindowAttribute для округления углов окна в Delphi 2007, вам нужно внести несколько изменений в предоставленный код, чтобы он корректно компилировался и работал с этой версией Delphi. Ниже приведены шаги, которые вам нужно выполнить.

Шаги для реализации округлых углов окон в Delphi 2007

1. Загрузка DWMAPI.dll динамически: Поскольку вы хотите сохранить совместимость с Windows 7 и 8, рекомендуется загружать библиотеку DWMAPI.dll динамически. Это позволит вам избежать ошибок на системах, где DWM не поддерживается.

2. Изменение интерфейса и реализации: Вам потребуется изменить интерфейс модуля, чтобы корректно работать с результатами функций из DWMAPI.

3. Использование Pointer вместо PByte: В Delphi 2007 необходимо использовать указатели с правильным типом. Вместо @DWM_WINDOW_CORNER_PREFERENCE мы будем использовать PCardinal(@DWM_WINDOW_CORNER_PREFERENCE).

Вот полный код, адаптированный для Delphi 2007:

unit delphi_rounded_corners;

interface

uses
  Windows, SysUtils;

type
  TRoundedWindowCornerType = (RoundedCornerDefault, RoundedCornerOff, RoundedCornerOn, RoundedCornerSmall);

procedure SetRoundedCorners(const TheHandle: HWND; const CornerType: TRoundedWindowCornerType);

implementation

const
  DWMWCP_DEFAULT    = 0; // Установить системные дефолтные настройки
  DWMWCP_DONOTROUND = 1; // Никогда не округлять углы окна
  DWMWCP_ROUND      = 2; // Округлять углы, если это возможно
  DWMWCP_ROUNDSMALL = 3; // Округлять углы с небольшим радиусом

  DWMWA_WINDOW_CORNER_PREFERENCE = 33; // Контроль округления углов

var
  DwmSetWindowAttribute: function(hWnd: HWND; Attribute: Integer; const Value: Pointer; Size: Cardinal): HResult; stdcall;

procedure LoadDwmApi;
var
  DwmApiHandle: HMODULE;
begin
  DwmApiHandle := LoadLibrary('Dwmapi.dll');
  if DwmApiHandle <> 0 then
  begin
    @DwmSetWindowAttribute := GetProcAddress(DwmApiHandle, 'DwmSetWindowAttribute');
    if @DwmSetWindowAttribute = nil then
      raise Exception.Create('Could not find DwmSetWindowAttribute in Dwmapi.dll.');
  end
  else
    raise Exception.Create('Could not load Dwmapi.dll.');
end;

procedure SetRoundedCorners(const TheHandle: HWND; const CornerType: TRoundedWindowCornerType);
var
  DWM_WINDOW_CORNER_PREFERENCE: Cardinal;
  Result: HResult;
begin
  LoadDwmApi; // Загрузить Dwmapi.dll

  case CornerType of
    RoundedCornerOff: DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_DONOTROUND;
    RoundedCornerOn: DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_ROUND;
    RoundedCornerSmall: DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_ROUNDSMALL;
  else
    DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_DEFAULT;
  end;

  // Вызов функции DwmSetWindowAttribute
  Result := DwmSetWindowAttribute(TheHandle, DWMWA_WINDOW_CORNER_PREFERENCE, PCardinal(@DWM_WINDOW_CORNER_PREFERENCE), SizeOf(DWM_WINDOW_CORNER_PREFERENCE));

  if Failed(Result) then
    raise Exception.Create('Failed to set window corner preference.');
end;

end.

Объяснение кода:

1. Загрузка библиотеки: Функция LoadDwmApi загружает DWMAPI.dll динамически и получает адрес функции DwmSetWindowAttribute.

2. Установка округления: В зависимости от значения CornerType, устанавливается нужный параметр для округления углов.

3. Проверка результата: Если вызов API DWM завершился неудачей, выбрасывается исключение.

Использование:

Вы можете использовать SetRoundedCorners(Self.Handle, RoundedCornerSmall); в любой процедуре вашего приложения, чтобы указать, как должны выглядеть углы вашего окна.

Теперь ваш исполняемый файл будет совместим с Windows 7 и 8 благодаря динамической загрузке DWMAPI.dll.