Трюки с формой 2.2.1: Тёмная тема Windows в Delphi 12

С возникновением тёмной темы Windows, появились вопросы, почему Delphi её не поддерживает. Вне зависимости от текущей темы, окошки серые, заголовки белые. Давайте попробуем разобраться, что такое тёмное тема в понимании Windows, и как её реализовать в Delphi малыми усилиями.

Содержание скрыть

Тёмная тема в понимании Windows

Тёмная тема в Delphi 12

Начинаем

Переключение между темами

Установить заголовок в тёмную тему

Странное поведение компонент при смене тем

Определить текущую тему Windows

Реакция на изменение в настройках Windows

Не чёрный заголовок, а тёмный

Range Check Error при bsNone

Листинги

Вспомогательный класс

Модуль формы

Тёмная тема в Delphi XE 7

Скачать

Тёмная тема в понимании Windows

Рекомендую ознакомиться со статьёй Microsoft: «Поддержка темной и светлой тем в приложениях Win32».

Исходя из текста статьи, под тёмной темой Microsoft считает нечто, диаметрально противоположное светлой теме. Философия в стиле Стетхама: «В жизни всегда есть две дороги: одна — первая, а другая — вторая». Забавно звучит, но это так. Нет API, которое бы по умолчанию закрасило окно и объекты Windows в цвета тёмной темы. Windows, вместо API, предоставляет рекомендации и глобальный параметр настройки, что дескать тема по умолчанию – тёмная (или светлая).

Из-за широкого разнообразия оформления пользовательского интерфейса в различных приложениях настройка определенного цветового режима, а также цвета переднего плана и фона является скорее рекомендацией, чем правилом

Всё, что у нас есть, это возможность определить, какая сейчас актуальная тема и установить заголовок, только заголовок, в тёмную(светлую) тему. Заголовок тёмной темы – это белые знаки системных кнопок и нулевой цвет для объединения по ИЛИ с желаемым цветом заголовка. И небольшая подсветка фона при утере фокуса.

Одним словом, реализацию тёмной темы, Windows целиком возлагает на нас. Ну, потому что из-за «широкого разнообразия оформления пользовательского интерфейса в различных приложениях», давать что-то стандартное, видимо, никто не решился.

Тёмная тема в Delphi 12

В 12-ой Delphi появились плюшки для Windows 11, типа перевода заголовка в тёмную тему и скруглённые углы формы, но без перевода всей остальной клиентской области. Исходя из доктрины Windows, относительно реализации тёмной темы, это уже не кажется таким удивительным.

В связи с этим, очевидно, что тёмную клиентскую область придётся делать руками. И тут есть два пути. Первый, ошибочный, это самостоятельно подменять все цвета всех компонент при смене темы. Второй, использовать стиль.

Почему ошибочный. Потому что просто изменить цвета для ряда компонент не получится. Это не повлияет на их внешний вид. Попробуйте поменять цвет шрифта у TButton, или цвет TCheckBox. Это может сделать только стиль, стандартный или видоизменённый с помощью StyleHook. В конце концов мы даже этим немного займёмся, подменив ловушку для TCustomForm, а сейчас просто возьмём стандартный тёмный стиль.

При использовании стиля, в контексте размещения компонент в заголовке, возникает неприятный нюанс. Для стиля такой возможности не предусмотрено. Стиль полностью контролирует заголовок и про наши игры с DWM не в курсе.

Начинаем

Берём проект для 12-ой Delphi из предыдущей статьи и подключаем стиль Windows10 Dark.

Последующий запуск проекта даёт такую картинку:

Тени нет. Стильный заголовок тут явно лишний. Убираем его:

StyleElements := StyleElements - [seBorder];

1	StyleElements := StyleElements - [seBorder];

Тень появилась, стильный заголовок исчез, aerosnap работает, размеры окна меняются. Текст в заголовке хуже некуда.

Переключение между темами

Важно, чтобы приложение запускалось со светлой темы. Это позиция Windows в том числе. Цитата из статьи «Не все приложения Win32 поддерживают темный режим, поэтому по умолчанию Windows предоставляет приложениям Win32 светлую строку заголовка». Поэтому в окне выше в выпадающем списке стиля по умолчанию выбираем Windows. Должно быть так:

У нас в проекте из предыдущей статьи был предусмотрен выпадающий список стилей, тот который в центре. Сделаем его csDropDownList и обработаем событие OnChange:

procedure TFmMain.ComboBox1Change(Sender: TObject);
begin
  if ComboBox1.ItemIndex=0 then
    TStyleManager.TrySetStyle('Windows')
  else
    TStyleManager.TrySetStyle('Windows10 Dark') ;
end;

procedure TFmMain.ComboBox1Change(Sender: TObject);

begin

if ComboBox1.ItemIndex=0 then

TStyleManager.TrySetStyle('Windows')

else

TStyleManager.TrySetStyle('Windows10 Dark') ;

end;

Запускаем, выбираем светлую тему:

Где-то явно не обработан GlassFrame формы. Нужен какой-то обработчик, который будет срабатывать при смене темы, устанавливать заголовок в тёмный или светлый режим и что-то ещё. Для начала, «что-то ещё» , это работа с GlassFrame. Создадим метод DoStyleChange, который в конечном счёте станет ключевым во всей этой затее:

procedure TFmMain.DoStyleChange;
begin
  FTitleInfo.UpdateGlassFrame;    
end;

procedure TFmMain.DoStyleChange;

begin

FTitleInfo.UpdateGlassFrame;

end;

Теперь его надо правильно вызвать. За событие смены стиля отвечает сообщение CM_CUSTOMSTYLECHANGED. Оно распространяется среди видимых форм путём PostMessage, поэтому внедряемся в уже переопределённый метод WndProc формы.

procedure TFmMain.WndProc(var Message: TMessage);
var StyleChanged: Boolean;
begin
  if HandleAllocated and
    DwmDefWindowProc(Handle, Message.Msg,
    Message.WParam, Message.LParam, Message.Result) then
    exit;
    
  StyleChanged := Message.Msg=CM_CUSTOMSTYLECHANGED;

  inherited;

  if StyleChanged then
  // if Message.Msg = CM_STYLECHANGED then
    DoStyleChange;
end;

procedure TFmMain.WndProc(var Message: TMessage);

var StyleChanged: Boolean;

begin

if HandleAllocated and

DwmDefWindowProc(Handle, Message.Msg,

Message.WParam, Message.LParam, Message.Result) then

exit;

StyleChanged := Message.Msg=CM_CUSTOMSTYLECHANGED;

inherited;

if StyleChanged then

// if Message.Msg = CM_STYLECHANGED then

DoStyleChange;

end;

Почему так замысловато. Вначале фиксируем, что это событие наше, потом отпускаем выполняться весь блок обработки сообщений, и только потом реагируем. Дело в том, что в процессе обработки этого сообщения, оно трансформируется в CM_STYLECHANGED. И нам нужно среагировать в самом конце всех промежуточных сообщений, которые будут посланы форме в процессе его обработки. Поэтому, сохраняем факт смены стиля, затем этот факт пережёвывает стилевой механизм, и только потом реагируем мы.

Теперь, при переключении в светлую тему, видим нормальный вид:

В тёмной теме пока не так хорошо, но это дело поправимое.

Установить заголовок в тёмную тему

Чтобы установить форму в тёмную тему в Delphi 12 существует метод формы EnableImmersiveDarkMode:

    /// <summary>
    /// On Windows 11 forms default to light mode regardless of the system setting.
    /// With this method you can have this form's frame drawn in dark mode colors
    /// when the dark mode system setting is enabled.
    /// </summary>
    procedure EnableImmersiveDarkMode(Enable: Boolean);

/// <summary>

/// On Windows 11 forms default to light mode regardless of the system setting.

/// With this method you can have this form's frame drawn in dark mode colors

/// when the dark mode system setting is enabled.

/// </summary>

procedure EnableImmersiveDarkMode(Enable: Boolean);

В комментарии:

В Windows 11 формы по умолчанию находятся в светлом режиме независимо от настроек системы. С помощью этого метода вы можете отрисовать рамку формы в цветах темного режима, когда включена настройка системы темного режима.

Но этот метод работает только для Windows 11. Хотя в 10-м тоже есть тёмная тема. Поэтому, чтобы не спорить с Delphi, напишем свой установщик для заголовка в нашем вспомогательном классе. Ну как напишем, позаимствуем.

class function TFormTitleInfo.SetDarkMode(AHandle: HWND; 
  ADark: Boolean): Boolean;
const
  DWMWA_USE_IMMERSIVE_DARK_MODE: DWORD = 20;
var
  ncrp: LongInt;
begin
  ncrp := Abs(NativeInt(ADark));
  Result := Succeeded(DwmSetWindowAttribute(AHandle,
    DWMWA_USE_IMMERSIVE_DARK_MODE, @ncrp, sizeof(LongInt)));
end;

class function TFormTitleInfo.SetDarkMode(AHandle: HWND;

ADark: Boolean): Boolean;

const

DWMWA_USE_IMMERSIVE_DARK_MODE: DWORD = 20;

var

ncrp: LongInt;

begin

ncrp := Abs(NativeInt(ADark));

Result := Succeeded(DwmSetWindowAttribute(AHandle,

DWMWA_USE_IMMERSIVE_DARK_MODE, @ncrp, sizeof(LongInt)));

end;

Есть соблазн переключиться в тёмную тему там же, где и переключаем стили, но это неправильно. Артефакты на кнопках и кривой заголовок останутся. Поэтому, в DoStyleChange дописываем установку тёмной (светлой) темы:

function TFmMain.FormIsDarkMode: Boolean;
begin
  Result := ComboBox1.ItemIndex>0;
end;

procedure TFmMain.DoStyleChange;
begin
  TFormTitleInfo.SetDarkMode(Handle, FormIsDarkMode);
  FTitleInfo.UpdateGlassFrame;    
end;

function TFmMain.FormIsDarkMode: Boolean;

begin

Result := ComboBox1.ItemIndex>0;

end;

procedure TFmMain.DoStyleChange;

begin

TFormTitleInfo.SetDarkMode(Handle, FormIsDarkMode);

FTitleInfo.UpdateGlassFrame;

end;

Артефакты ушли, заголовок отрисовался нормально. Но заголовок не стал тёмным и системных кнопок не наблюдается. Без использования стиля заголовок был бы чёрным. Если есть стиль, то нам надо перерисовать область под заголовком. Но мы не хотим ничего перерисовывать, поэтому допишем ещё строку в обработчик смены стиля, в которой установим текущий цвет формы:

procedure TFmMain.DoStyleChange;
begin
  TFormTitleInfo.SetDarkMode(Handle, FormIsDarkMode);
  FTitleInfo.UpdateGlassFrame;   
  Color := TStyleManager.ActiveStyle.GetStyleColor(scWindow); 
end;

procedure TFmMain.DoStyleChange;

begin

TFormTitleInfo.SetDarkMode(Handle, FormIsDarkMode);

FTitleInfo.UpdateGlassFrame;

Color := TStyleManager.ActiveStyle.GetStyleColor(scWindow);

end;

Появились системные кнопки, которые ведут себя просто замечательно. И куда-то пропал заголовок. Заголовка не видно, потому что он рисуется по прежнему, как для светлой темы, тёмными буквами. В отрисовщике заголовка вспомогательного класса учтём наличие тёмной темы. Наличие тёмной темы, это просто наличие активного пользовательского стиля. Полный текст в листингах в конце статьи.

class procedure TFormTitleInfo.DrawTitleCaption(AForm: TCustomForm; 
  ACanvas: TCanvas; const AFrameRect: TRect; var ARect: TRect);
  ...
begin
  ...
  StyleTextOptions.Flags := [stfTextColor];
  if TStyleManager.IsCustomStyleActive and AForm.Active then
    StyleTextOptions.TextColor := 
      StyleServices(AForm).GetStyleFontColor(sfCaptionTextNormal)
  else 
    StyleTextOptions.TextColor := CaptionColors[AForm.Active];

  TStyleManager.SystemStyle.DrawText(ACanvas.Handle,
    TStyleManager.SystemStyle.GetElementDetails(twCaptionActive),
    AForm.Caption, ARect,
    [tfSingleLine, tfLeft, tfVerticalCenter, tfEndEllipsis, tfComposited],
    StyleTextOptions);
end;

class procedure TFormTitleInfo.DrawTitleCaption(AForm: TCustomForm;

ACanvas: TCanvas; const AFrameRect: TRect; var ARect: TRect);

...

begin

...

StyleTextOptions.Flags := [stfTextColor];

if TStyleManager.IsCustomStyleActive and AForm.Active then

StyleTextOptions.TextColor :=

StyleServices(AForm).GetStyleFontColor(sfCaptionTextNormal)

else

StyleTextOptions.TextColor := CaptionColors[AForm.Active];

TStyleManager.SystemStyle.DrawText(ACanvas.Handle,

TStyleManager.SystemStyle.GetElementDetails(twCaptionActive),

AForm.Caption, ARect,

[tfSingleLine, tfLeft, tfVerticalCenter, tfEndEllipsis, tfComposited],

StyleTextOptions);

end;

Казалось бы, всё. Но куда пропала надпись «Read more on IP76.RU…» снизу справа? Она уехала вниз (((

Странное поведение компонент при смене тем

Поставим кнопку и метку на форму, зададим обоим выравнивание:

Anchors := [akRight,akBottom]

1	Anchors := [akRight,akBottom]

После нескольких переключений тем, видим следующее:

Выровненные таким образом контролы уползают вниз. После долгих поисков нашёлся виновник. Им оказался обработчик WM_NCCALCSIZE. Оказывается, во время смены стиля, не надо задавать смещения, иначе ломается AlignControl.

Допишем в обработчик смены стилей признак того, что сейчас надо действительно сменить стиль:

procedure TFmMain.ComboBox1Change(Sender: TObject);
begin
  FStyleChanging := 
    (ComboBox1.ItemIndex=0) and TStyleManager.IsCustomStyleActive or
    (ComboBox1.ItemIndex<>0) and not TStyleManager.IsCustomStyleActive; 
  if not FStyleChanging then exit;
  
  if ComboBox1.ItemIndex=0 then
    TStyleManager.TrySetStyle('Windows')
  else
    TStyleManager.TrySetStyle('Windows10 Dark') ;
end;

procedure TFmMain.ComboBox1Change(Sender: TObject);

begin

FStyleChanging :=

(ComboBox1.ItemIndex=0) and TStyleManager.IsCustomStyleActive or

(ComboBox1.ItemIndex<>0) and not TStyleManager.IsCustomStyleActive;

if not FStyleChanging then exit;

if ComboBox1.ItemIndex=0 then

TStyleManager.TrySetStyle('Windows')

else

TStyleManager.TrySetStyle('Windows10 Dark') ;

end;

А в обработчик сообщения WM_NCCALCSIZE добавим условие не выполнять вычислений, если стиль меняется. Также учтём признак видимости формы. На тот случай, когда стартуем в тёмной теме Windows. Полный текст в листингах в конце статьи.

procedure TFmMain.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  if // Меняется стиль, ничего не вычисляем
    not FStyleChanging and (not FormIsDarkMode or Visible) and
    (FTitleInfo<>nil) and (WindowState <> wsMinimized) and
    Message.CalcValidRects then
  begin
    var Params := Message.CalcSize_Params;
    ...
  end
  else
    inherited;
end;

procedure TFmMain.WMNCCalcSize(var Message: TWMNCCalcSize);

begin

if // Меняется стиль, ничего не вычисляем

not FStyleChanging and (not FormIsDarkMode or Visible) and

(FTitleInfo<>nil) and (WindowState <> wsMinimized) and

Message.CalcValidRects then

begin

var Params := Message.CalcSize_Params;

...

end

else

inherited;

end;

Признак смены стиля гарантировано сбрасываем в DoStyleChange:

procedure TFmMain.DoStyleChange;
begin
  FStyleChanging := False;
  TFormTitleInfo.SetDarkMode(Handle, FormIsDarkMode);
  FTitleInfo.UpdateGlassFrame;    
  Color := TStyleManager.ActiveStyle.GetStyleColor(scWindow);
end;

procedure TFmMain.DoStyleChange;

begin

FStyleChanging := False;

TFormTitleInfo.SetDarkMode(Handle, FormIsDarkMode);

FTitleInfo.UpdateGlassFrame;

Color := TStyleManager.ActiveStyle.GetStyleColor(scWindow);

end;

Поэтому мы не стали вешаться на CM_STYLECHANGED в WndProc. Нам нужно гарантированно сбросить признак изменения стиля, и что он там выдаст после всех обработок – фиг знает.

Определить текущую тему Windows

Дописываем в наш вспомогательный класс определитель текущей темы в ОС (источник тот же):

class function TFormTitleInfo.DarkModeIsEnabled: Boolean;
{$IFDEF MSWINDOWS}
const
  TheValue = 'AppsUseLightTheme';
  TheKey   = 'Software\Microsoft\Windows\CurrentVersion\Themes\Personalize\' ;
var
  Reg: TRegistry;
{$ENDIF}
begin
  Result := False;  // There is no dark side - the Jedi are victorious!

// This relies on a registry setting only available on MS Windows
// If the developer has somehow managed to get to this point then tell
// them not to do this!
{$IFNDEF MSWINDOWS}
{$MESSAGE WARN '"DarkModeIsEnabled" will only work on MS Windows targets'}
{$ELSE}
  Reg    := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.KeyExists(TheKey) then
      if Reg.OpenKey(TheKey, False) then
      try
        if Reg.ValueExists(TheValue) then
          Result := Reg.ReadInteger(TheValue) = 0;
      finally
        Reg.CloseKey;
      end;
  finally
    Reg.Free;
  end;
{$ENDIF}
end;

class function TFormTitleInfo.DarkModeIsEnabled: Boolean;

{$IFDEF MSWINDOWS}

const

TheValue = 'AppsUseLightTheme';

TheKey = 'Software\Microsoft\Windows\CurrentVersion\Themes\Personalize\' ;

var

Reg: TRegistry;

{$ENDIF}

begin

Result := False; // There is no dark side - the Jedi are victorious!

// This relies on a registry setting only available on MS Windows

// If the developer has somehow managed to get to this point then tell

// them not to do this!

{$IFNDEF MSWINDOWS}

{$MESSAGE WARN '"DarkModeIsEnabled" will only work on MS Windows targets'}

{$ELSE}

Reg := TRegistry.Create(KEY_READ);

try

Reg.RootKey := HKEY_CURRENT_USER;

if Reg.KeyExists(TheKey) then

if Reg.OpenKey(TheKey, False) then

try

if Reg.ValueExists(TheValue) then

Result := Reg.ReadInteger(TheValue) = 0;

finally

Reg.CloseKey;

end;

finally

Reg.Free;

end;

{$ENDIF}

end;

Пишем метод формы, определяющий и устанавливающий нужную тему.

procedure TFmMain.CheckWindowTheme;
begin
  ComboBox1.ItemIndex := Ord(TFormTitleInfo.DarkModeIsEnabled);
  ComboBox1Change(nil);
end;

procedure TFmMain.CheckWindowTheme;

begin

ComboBox1.ItemIndex := Ord(TFormTitleInfo.DarkModeIsEnabled);

ComboBox1Change(nil);

end;

И вызываем его, например, в обработчике OnCreate формы.

Реакция на изменение в настройках Windows

Вряд ли это будет происходить часто, но для полноты картины учтём и это. При изменении настроек, в том числе текущей темы, всем окнам в системе рассылается сообщение WM_SETTINGCHANGE. Обработчик пусть выглядит следующим образом:

procedure TFmMain.WMSettingChange(var Message: TWMSettingChange);
begin
  inherited;
  if FStyleChanging then exit;  
  if Message.Section='ImmersiveColorSet' then
    CheckWindowTheme;
end;

procedure TFmMain.WMSettingChange(var Message: TWMSettingChange);

begin

inherited;

if FStyleChanging then exit;

if Message.Section='ImmersiveColorSet' then

CheckWindowTheme;

end;

Не чёрный заголовок, а тёмный

В парадигме Windows, изложенной выше, цвет заголовка не должен быть чёрным, он должен позволять себе быть тёмным, в контексте собственной темы. Поэтому, сменим кардинально чёрную тему Windows10 Dark на что-то не такое чёрное, например Carbon. Подключаем стиль, не забываем оставить Windows по умолчанию. В переключалке тем вместо Windows10 Dark пишем Carbon:

procedure TFmMain.ComboBox1Change(Sender: TObject);
begin
  FStyleChanging := 
    (ComboBox1.ItemIndex=0) and TStyleManager.IsCustomStyleActive or
    (ComboBox1.ItemIndex<>0) and not TStyleManager.IsCustomStyleActive; 
  if not FStyleChanging then exit;
  
  if ComboBox1.ItemIndex=0 then
    TStyleManager.TrySetStyle('Windows')
  else
    // TStyleManager.TrySetStyle('Windows10 Dark') ;
    TStyleManager.TrySetStyle('Carbon') ;
end;

procedure TFmMain.ComboBox1Change(Sender: TObject);

begin

FStyleChanging :=

(ComboBox1.ItemIndex=0) and TStyleManager.IsCustomStyleActive or

(ComboBox1.ItemIndex<>0) and not TStyleManager.IsCustomStyleActive;

if not FStyleChanging then exit;

if ComboBox1.ItemIndex=0 then

TStyleManager.TrySetStyle('Windows')

else

// TStyleManager.TrySetStyle('Windows10 Dark') ;

TStyleManager.TrySetStyle('Carbon') ;

end;

И видим совершенно функциональный заголовок нашей тёмной, но не чёрной, темы:

Эффект достигнут за счёт присваивания цвету формы текущего цвета стиля для окна. Нам не нужен кардинально чёрный заголовок. Windows не предоставляет тёмной темы, он предоставляет возможности для неё.

Нажмём кнопку с лупой. Увидим диалоговое окошко:

Мы не можем простым путём повлиять на заголовок этого окошка, и любых других стандартных диалоговых окошек. Они все будут иметь заголовок выбранной темы.

Кардинально чёрный заголовок не для того, чтобы присутствовать только в таком виде в каждом окне. Он таков, чтобы без проблем объединиться с текущим предложенным цветом. В приложении всё должно соответствовать дизайнерскому замыслу автора.

С кнопкой закрытия окна есть небольшое расхождение. Но есть другие стили, где кнопка закрытия более подходящая. Например, Windows10 SlateGray:

А если свойству Color формы будем присваивать другое значение цвета стиля, например границы окна, то добьёмся идеальной тёмной темы, где все заголовки для всех окон одного цвета:

Color := TStyleManager.ActiveStyle.GetStyleColor(scBorder);

1	Color := TStyleManager.ActiveStyle.GetStyleColor(scBorder);

Опробуем тёмную тему от delphistyles:

Классная тёмная тема. В одной из следующих статей выложу бесплатный вариант этого стиля.

Range Check Error при bsNone

Это к тёмной теме не относится, но надо рассказать. При переводе рамки окна в стиль bsNone наблюдается ошибка:

Эта проверка обычно включена в дебаге и отключена в релизе. Поэтому, чтобы этого не возникало, можно отключить для дебага опцию Range checking:

Или же, чтобы не возникало лишних вопросов, отключим проверку на диапазон в конкретном месте директивой $RANGECHECKS. Полный текст в листингах в конце статьи.

class function TFormTitleInfo.GetAdjustWindowRect(AHandle: HWND): TRect;
var dwStyle, dwExStyle: DWORD;
begin
  ...
  {$RANGECHECKS OFF}
  dwStyle := GetWindowLong(AHandle, GWL_STYLE);
  dwExStyle := GetWindowLong(AHandle, GWL_EXSTYLE);
  {$RANGECHECKS ON}
  ...
end;

class function TFormTitleInfo.GetAdjustWindowRect(AHandle: HWND): TRect;

var dwStyle, dwExStyle: DWORD;

begin

...

{$RANGECHECKS OFF}

dwStyle := GetWindowLong(AHandle, GWL_STYLE);

dwExStyle := GetWindowLong(AHandle, GWL_EXSTYLE);

{$RANGECHECKS ON}

...

end;

Листинги

Традиционно привожу полные листинги, их снова немного.

Вспомогательный класс

TFormTitleInfo

//******************************************************************************
//  Project: IP76.RU
//  Created: 2024-08-10
//  Article: https://ip76.ru/dark-mode-formD23
//  Описание: Вспомогательный класс для размещение элементов управления 
//            в заголовке окна
//            Тёмная тема Windows
//******************************************************************************

unit IP76.FormTitleInfo;

interface

uses
  Winapi.Windows,  Winapi.ShellAPi, System.SysUtils, System.Types,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.Themes;

type
  TFormTitleInfo = class
  public const
    IconWindowOffset = 2;
    IconTextMargin = 5;
  private
    FOwner: TCustomForm;
    FFrameRect: TRect;
    function GetFrameRect: TRect;
  public
    // Получить прямоугольник области панели задач
    class function GetTaskBarBounds: TRect; static;
    // Получить смещения по краям окна
    class function GetAdjustWindowRect(AHandle: HWND): TRect; static;
    // Получить прямоугольник иконки в заголовке окна
    class procedure GetIconRect(AForm: TCustomForm; 
      const AFrameRect: TRect; out ARect: TRect); overload; static;
    // Обновить GlassFrame формы и заставить окно применить изменения
    class procedure UpdateGlassFrame(AForm: TCustomForm;
      out ARect: TRect); overload; static;
    // Нарисовать иконку окна
    class procedure DrawTitleIcon(AForm: TCustomForm; ACanvas: TCanvas;
      const ARect: TRect); overload; static;
    // Нарисовать титл окна
    class procedure DrawTitleCaption(AForm: TCustomForm; ACanvas: TCanvas;
      const AFrameRect: TRect; var ARect: TRect); overload; static;
    // Активна ли тёмная тема Windows
    // Source: https://github.com/checkdigits/delphidarkmode     
    class function DarkModeIsEnabled: Boolean; static;
    // Установить тёмную или светлую тему
    // Source: https://github.com/checkdigits/delphidarkmode 
    class function SetDarkMode(AHandle: HWND; ADark: Boolean): Boolean; static;

    procedure UpdateGlassFrame; overload;
    function GetIconRect: TRect; overload;
    procedure DrawTitleIcon(ACanvas: TCanvas; out ARect: TRect); overload;
    procedure DrawTitleCaption(ACanvas: TCanvas; var ARect: TRect); overload;
  public
    constructor Create(AOwner: TCustomForm);
    property FrameRect: TRect read GetFrameRect;
  end;

implementation

uses WinApi.DwmApi, System.Math, System.Win.Registry;

{TFormTitleInfo}

constructor TFormTitleInfo.Create(AOwner: TCustomForm);
begin
  FOwner := AOwner;
  FFrameRect := TRect.Empty;
end;

function TFormTitleInfo.GetFrameRect: TRect;
begin
  if FFrameRect.IsEmpty and (FOwner<>nil) then
  begin
    FOwner.HandleNeeded;
    if not FOwner.HandleAllocated then exit;
    FFrameRect := GetAdjustWindowRect(FOwner.Handle);
  end;
  Result := FFrameRect;
end;

class function TFormTitleInfo.GetTaskBarBounds: TRect;
var D: TAppBarData;
begin
  D.cbSize := SizeOf(D);
  if SHAppBarMessage(ABM_GETTASKBARPOS, D) > 0 then
    Result := D.rc
  else
    Result := TRect.Empty;
end;

class function TFormTitleInfo.GetAdjustWindowRect(AHandle: HWND): TRect;
var dwStyle, dwExStyle: DWORD;
begin
  Result := TRect.Empty;
  {$RANGECHECKS OFF}
  dwStyle := GetWindowLong(AHandle, GWL_STYLE);
  dwExStyle := GetWindowLong(AHandle, GWL_EXSTYLE);
  {$RANGECHECKS ON}
  {$IF CompilerVersion < 34}
  AdjustWindowRectEx(Result, dwStyle,  False, dwExStyle);
  {$ELSE}
  // Версия Delphi 10.4 и выше
  // Местонахождение: Vcl.Controls
  AdjustWindowRectExForWindow(Result, dwStyle, False, dwExStyle, AHandle);
  {$ENDIF}
end;

type
  TCustomFormWrapper = class(TCustomForm);

class procedure TFormTitleInfo.GetIconRect(AForm: TCustomForm; 
  const AFrameRect: TRect; out ARect: TRect);
var Size: Integer;
begin
  ARect := TRect.Empty;
  if (AForm=nil) or
    not (biSystemMenu in TCustomFormWrapper(AForm).BorderIcons) or
    not (AForm.BorderStyle in [bsSingle, bsSizeable]) then
    exit;

  if TOSVersion.Check(10) then
    if AForm.WindowState=wsMaximized then
      ARect.Left := IconWindowOffset
    else
      ARect.Left := AFrameRect.Right;

  {$IF CompilerVersion < 34}
  Size := GetSystemMetrics(SM_CXSMICON);
  {$ELSE}
  Size := GetSystemMetricsForWindow(SM_CXSMICON, AForm.Handle);
  {$ENDIF}

  ARect.Right := ARect.Left + Size;
  if (AForm.WindowState = wsMaximized) then
    ARect.Top := (Abs(AFrameRect.Top) - AFrameRect.Right - Size) div 2
  else
    ARect.Top := (Abs(AFrameRect.Top) - Size) div 2;
  ARect.Bottom := ARect.Top + Size;
end;

class procedure TFormTitleInfo.UpdateGlassFrame(AForm: TCustomForm; 
  out ARect: TRect);
begin
  ARect := TRect.Empty;
  if AForm = nil then exit;

  AForm.HandleNeeded;
  if not AForm.HandleAllocated then exit;
  ARect := GetAdjustWindowRect(AForm.Handle);

  if AForm.BorderStyle in [bsNone, bsSizeable, bsSizeToolWin] then
    // если тут сделать +1, будет видна едва заметная серая полоса
    AForm.GlassFrame.Top := -ARect.Top
  else
    // +1, боремся с полосой в 1 пиксел при nonsizeable стилях
    AForm.GlassFrame.Top := -ARect.Top + 1;

  AForm.GlassFrame.Enabled := True;
  SetWindowPos(AForm.Handle, 0,
    AForm.Left, AForm.Top, AForm.Width, AForm.Height,
    SWP_FRAMECHANGED or SWP_NOACTIVATE);
end;

class procedure TFormTitleInfo.DrawTitleIcon(AForm: TCustomForm; 
  ACanvas: TCanvas; const ARect: TRect);
var
  h: HICON;
  Icon: TIcon;
  Size: Integer;
  bmp: TBitmap;
begin
  if ARect.IsEmpty then exit;

  Size := ARect.Height;
  Icon := TIcon.Create;
  try
    if not TCustomFormWrapper(AForm).Icon.Empty then
      h := TCustomFormWrapper(AForm).Icon.Handle
    else
      h := Application.Icon.Handle;
    Icon.Handle := CopyImage(h, IMAGE_ICON, Size, Size, LR_COPYFROMRESOURCE);
    bmp := TBitmap.Create;
    try
      bmp.Assign(Icon);
      ACanvas.Draw(ARect.Left, ARect.Top, bmp);
    finally
      bmp.Free;
    end;
  finally
    Icon.Free;
  end;
end;

class procedure TFormTitleInfo.DrawTitleCaption(AForm: TCustomForm; 
  ACanvas: TCanvas; const AFrameRect: TRect; var ARect: TRect);
const
  CaptionColors: array[Boolean] of TColor =
    (clBtnShadow{clInActiveCaptionText}, clCaptionText);
var
  StyleTextOptions: TStyleTextOptions;
  NonClientMetrics: TNonClientMetrics;
begin
  ARect.Top := 0;
  if (AForm.WindowState = wsMaximized) then
    ARect.Bottom := Abs(AFrameRect.Top) - AFrameRect.Right
  else
    ARect.Bottom := -AFrameRect.Top;
  ARect.Left := ARect.Left + IconTextMargin;

  FillChar(NonClientMetrics, SizeOf(NonClientMetrics), 0);
  NonClientMetrics.cbSize := SizeOf(NonClientMetrics);

  {$IF CompilerVersion < 34}
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS,
    SizeOf(NonClientMetrics), @NonClientMetrics, 0)
  {$ELSE}
  if SystemParametersInfoForWindow(SPI_GETNONCLIENTMETRICS,
    SizeOf(NonClientMetrics), @NonClientMetrics, 0, AForm.Handle)
  {$ENDIF}
  then
    if AForm.BorderStyle in [bsToolWindow, bsSizeToolWin] then
      ACanvas.Font.Handle :=
        CreateFontIndirect(NonClientMetrics.lfSmCaptionFont)
    else
      ACanvas.Font.Handle :=
        CreateFontIndirect(NonClientMetrics.lfCaptionFont);

  StyleTextOptions.Flags := [stfTextColor];
  if TStyleManager.IsCustomStyleActive and AForm.Active then
    StyleTextOptions.TextColor := 
      TStyleManager.ActiveStyle.GetStyleFontColor(sfCaptionTextNormal)
  else 
    StyleTextOptions.TextColor := CaptionColors[AForm.Active];

  TStyleManager.SystemStyle.DrawText(ACanvas.Handle,
    TStyleManager.SystemStyle.GetElementDetails(twCaptionActive),
    AForm.Caption, ARect,
    [tfSingleLine, tfLeft, tfVerticalCenter, tfEndEllipsis, tfComposited],
    StyleTextOptions);
end;

class function TFormTitleInfo.DarkModeIsEnabled: Boolean;
{$IFDEF MSWINDOWS}
const
  TheKey   = 'Software\Microsoft\Windows\CurrentVersion\Themes\Personalize\';
  TheValue = 'AppsUseLightTheme';
var
  Reg: TRegistry;
{$ENDIF}
begin

  Result := False;  // There is no dark side - the Jedi are victorious!

// This relies on a registry setting only available on MS Windows
// If the developer has somehow managed to get to this point then tell
// them not to do this!
{$IFNDEF MSWINDOWS}
{$MESSAGE WARN '"DarkModeIsEnabled" will only work on MS Windows targets'}
{$ELSE}
  Reg    := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.KeyExists(TheKey) then
      if Reg.OpenKey(TheKey, False) then
      try
        if Reg.ValueExists(TheValue) then
          Result := Reg.ReadInteger(TheValue) = 0;
      finally
        Reg.CloseKey;
      end;
  finally
    Reg.Free;
  end;
{$ENDIF}
end;

class function TFormTitleInfo.SetDarkMode(AHandle: HWND; 
  ADark: Boolean): Boolean;
const
  DWMWA_USE_IMMERSIVE_DARK_MODE: DWORD = 20;
var
  ncrp: LongInt;
begin
  ncrp := Abs(NativeInt(ADark));
  Result := Succeeded(DwmSetWindowAttribute(AHandle,
    DWMWA_USE_IMMERSIVE_DARK_MODE, @ncrp, sizeof(LongInt)));
end;

function TFormTitleInfo.GetIconRect: TRect;
begin
  GetIconRect(FOwner, FrameRect, Result);
end;

procedure TFormTitleInfo.UpdateGlassFrame;
begin
  if FOwner=nil then exit;
  UpdateGlassFrame(FOwner, FFrameRect);
end;

procedure TFormTitleInfo.DrawTitleIcon(ACanvas: TCanvas; out ARect: TRect);
begin
  ARect := GetIconRect;
  DrawTitleIcon(FOwner, ACanvas, ARect);
end;

procedure TFormTitleInfo.DrawTitleCaption(ACanvas: TCanvas; var ARect: TRect);
begin
  DrawTitleCaption(FOwner, ACanvas, FrameRect, ARect);
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

//******************************************************************************

// Project: IP76.RU

// Created: 2024-08-10

// Article: https://ip76.ru/dark-mode-formD23

// Описание: Вспомогательный класс для размещение элементов управления

// в заголовке окна

// Тёмная тема Windows

//******************************************************************************

unit IP76.FormTitleInfo;

interface

uses

Winapi.Windows, Winapi.ShellAPi, System.SysUtils, System.Types,

Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.Themes;

type

TFormTitleInfo = class

public const

IconWindowOffset = 2;

IconTextMargin = 5;

private

FOwner: TCustomForm;

FFrameRect: TRect;

function GetFrameRect: TRect;

public

// Получить прямоугольник области панели задач

class function GetTaskBarBounds: TRect; static;

// Получить смещения по краям окна

class function GetAdjustWindowRect(AHandle: HWND): TRect; static;

// Получить прямоугольник иконки в заголовке окна

class procedure GetIconRect(AForm: TCustomForm;

const AFrameRect: TRect; out ARect: TRect); overload; static;

// Обновить GlassFrame формы и заставить окно применить изменения

class procedure UpdateGlassFrame(AForm: TCustomForm;

out ARect: TRect); overload; static;

// Нарисовать иконку окна

class procedure DrawTitleIcon(AForm: TCustomForm; ACanvas: TCanvas;

const ARect: TRect); overload; static;

// Нарисовать титл окна

class procedure DrawTitleCaption(AForm: TCustomForm; ACanvas: TCanvas;

const AFrameRect: TRect; var ARect: TRect); overload; static;

// Активна ли тёмная тема Windows

// Source: https://github.com/checkdigits/delphidarkmode

class function DarkModeIsEnabled: Boolean; static;

// Установить тёмную или светлую тему

// Source: https://github.com/checkdigits/delphidarkmode

class function SetDarkMode(AHandle: HWND; ADark: Boolean): Boolean; static;

procedure UpdateGlassFrame; overload;

function GetIconRect: TRect; overload;

procedure DrawTitleIcon(ACanvas: TCanvas; out ARect: TRect); overload;

procedure DrawTitleCaption(ACanvas: TCanvas; var ARect: TRect); overload;

public

constructor Create(AOwner: TCustomForm);

property FrameRect: TRect read GetFrameRect;

end;

implementation

uses WinApi.DwmApi, System.Math, System.Win.Registry;

{TFormTitleInfo}

constructor TFormTitleInfo.Create(AOwner: TCustomForm);

begin

FOwner := AOwner;

FFrameRect := TRect.Empty;

end;

function TFormTitleInfo.GetFrameRect: TRect;

begin

if FFrameRect.IsEmpty and (FOwner<>nil) then

begin

FOwner.HandleNeeded;

if not FOwner.HandleAllocated then exit;

FFrameRect := GetAdjustWindowRect(FOwner.Handle);

end;

Result := FFrameRect;

end;

class function TFormTitleInfo.GetTaskBarBounds: TRect;

var D: TAppBarData;

begin

D.cbSize := SizeOf(D);

if SHAppBarMessage(ABM_GETTASKBARPOS, D) > 0 then

Result := D.rc

else

Result := TRect.Empty;

end;

class function TFormTitleInfo.GetAdjustWindowRect(AHandle: HWND): TRect;

var dwStyle, dwExStyle: DWORD;

begin

Result := TRect.Empty;

{$RANGECHECKS OFF}

dwStyle := GetWindowLong(AHandle, GWL_STYLE);

dwExStyle := GetWindowLong(AHandle, GWL_EXSTYLE);

{$RANGECHECKS ON}

{$IF CompilerVersion < 34}

AdjustWindowRectEx(Result, dwStyle, False, dwExStyle);

{$ELSE}

// Версия Delphi 10.4 и выше

// Местонахождение: Vcl.Controls

AdjustWindowRectExForWindow(Result, dwStyle, False, dwExStyle, AHandle);

{$ENDIF}

end;

type

TCustomFormWrapper = class(TCustomForm);

class procedure TFormTitleInfo.GetIconRect(AForm: TCustomForm;

const AFrameRect: TRect; out ARect: TRect);

var Size: Integer;

begin

ARect := TRect.Empty;

if (AForm=nil) or

not (biSystemMenu in TCustomFormWrapper(AForm).BorderIcons) or

not (AForm.BorderStyle in [bsSingle, bsSizeable]) then

exit;

if TOSVersion.Check(10) then

if AForm.WindowState=wsMaximized then

ARect.Left := IconWindowOffset

else

ARect.Left := AFrameRect.Right;

{$IF CompilerVersion < 34}

Size := GetSystemMetrics(SM_CXSMICON);

{$ELSE}

Size := GetSystemMetricsForWindow(SM_CXSMICON, AForm.Handle);

{$ENDIF}

ARect.Right := ARect.Left + Size;

if (AForm.WindowState = wsMaximized) then

ARect.Top := (Abs(AFrameRect.Top) - AFrameRect.Right - Size) div 2

else

ARect.Top := (Abs(AFrameRect.Top) - Size) div 2;

ARect.Bottom := ARect.Top + Size;

end;

class procedure TFormTitleInfo.UpdateGlassFrame(AForm: TCustomForm;

out ARect: TRect);

begin

ARect := TRect.Empty;

if AForm = nil then exit;

AForm.HandleNeeded;

if not AForm.HandleAllocated then exit;

ARect := GetAdjustWindowRect(AForm.Handle);

if AForm.BorderStyle in [bsNone, bsSizeable, bsSizeToolWin] then

// если тут сделать +1, будет видна едва заметная серая полоса

AForm.GlassFrame.Top := -ARect.Top

else

// +1, боремся с полосой в 1 пиксел при nonsizeable стилях

AForm.GlassFrame.Top := -ARect.Top + 1;

AForm.GlassFrame.Enabled := True;

SetWindowPos(AForm.Handle, 0,

AForm.Left, AForm.Top, AForm.Width, AForm.Height,

SWP_FRAMECHANGED or SWP_NOACTIVATE);

end;

class procedure TFormTitleInfo.DrawTitleIcon(AForm: TCustomForm;

ACanvas: TCanvas; const ARect: TRect);

var

h: HICON;

Icon: TIcon;

Size: Integer;

bmp: TBitmap;

begin

if ARect.IsEmpty then exit;

Size := ARect.Height;

Icon := TIcon.Create;

try

if not TCustomFormWrapper(AForm).Icon.Empty then

h := TCustomFormWrapper(AForm).Icon.Handle

else

h := Application.Icon.Handle;

Icon.Handle := CopyImage(h, IMAGE_ICON, Size, Size, LR_COPYFROMRESOURCE);

bmp := TBitmap.Create;

try

bmp.Assign(Icon);

ACanvas.Draw(ARect.Left, ARect.Top, bmp);

finally

bmp.Free;

end;

finally

Icon.Free;

end;

class procedure TFormTitleInfo.DrawTitleCaption(AForm: TCustomForm;

ACanvas: TCanvas; const AFrameRect: TRect; var ARect: TRect);

const

CaptionColors: array[Boolean] of TColor =

(clBtnShadow{clInActiveCaptionText}, clCaptionText);

var

StyleTextOptions: TStyleTextOptions;

NonClientMetrics: TNonClientMetrics;

begin

ARect.Top := 0;

if (AForm.WindowState = wsMaximized) then

ARect.Bottom := Abs(AFrameRect.Top) - AFrameRect.Right

else

ARect.Bottom := -AFrameRect.Top;

ARect.Left := ARect.Left + IconTextMargin;

FillChar(NonClientMetrics, SizeOf(NonClientMetrics), 0);

NonClientMetrics.cbSize := SizeOf(NonClientMetrics);

{$IF CompilerVersion < 34}

if SystemParametersInfo(SPI_GETNONCLIENTMETRICS,

SizeOf(NonClientMetrics), @NonClientMetrics, 0)

{$ELSE}

if SystemParametersInfoForWindow(SPI_GETNONCLIENTMETRICS,

SizeOf(NonClientMetrics), @NonClientMetrics, 0, AForm.Handle)

{$ENDIF}

then

if AForm.BorderStyle in [bsToolWindow, bsSizeToolWin] then

ACanvas.Font.Handle :=

CreateFontIndirect(NonClientMetrics.lfSmCaptionFont)

else

ACanvas.Font.Handle :=

CreateFontIndirect(NonClientMetrics.lfCaptionFont);

StyleTextOptions.Flags := [stfTextColor];

if TStyleManager.IsCustomStyleActive and AForm.Active then

StyleTextOptions.TextColor :=

TStyleManager.ActiveStyle.GetStyleFontColor(sfCaptionTextNormal)

else

StyleTextOptions.TextColor := CaptionColors[AForm.Active];

TStyleManager.SystemStyle.DrawText(ACanvas.Handle,

TStyleManager.SystemStyle.GetElementDetails(twCaptionActive),

AForm.Caption, ARect,

[tfSingleLine, tfLeft, tfVerticalCenter, tfEndEllipsis, tfComposited],

StyleTextOptions);

end;

class function TFormTitleInfo.DarkModeIsEnabled: Boolean;

{$IFDEF MSWINDOWS}

const

TheKey = 'Software\Microsoft\Windows\CurrentVersion\Themes\Personalize\';

TheValue = 'AppsUseLightTheme';

var

Reg: TRegistry;

{$ENDIF}

begin

Result := False; // There is no dark side - the Jedi are victorious!

// This relies on a registry setting only available on MS Windows

// If the developer has somehow managed to get to this point then tell

// them not to do this!

{$IFNDEF MSWINDOWS}

{$MESSAGE WARN '"DarkModeIsEnabled" will only work on MS Windows targets'}

{$ELSE}

Reg := TRegistry.Create(KEY_READ);

try

Reg.RootKey := HKEY_CURRENT_USER;

if Reg.KeyExists(TheKey) then

if Reg.OpenKey(TheKey, False) then

try

if Reg.ValueExists(TheValue) then

Result := Reg.ReadInteger(TheValue) = 0;

finally

Reg.CloseKey;

end;

finally

Reg.Free;

end;

{$ENDIF}

end;

class function TFormTitleInfo.SetDarkMode(AHandle: HWND;

ADark: Boolean): Boolean;

const

DWMWA_USE_IMMERSIVE_DARK_MODE: DWORD = 20;

var

ncrp: LongInt;

begin

ncrp := Abs(NativeInt(ADark));

Result := Succeeded(DwmSetWindowAttribute(AHandle,

DWMWA_USE_IMMERSIVE_DARK_MODE, @ncrp, sizeof(LongInt)));

end;

function TFormTitleInfo.GetIconRect: TRect;

begin

GetIconRect(FOwner, FrameRect, Result);

end;

procedure TFormTitleInfo.UpdateGlassFrame;

begin

if FOwner=nil then exit;

UpdateGlassFrame(FOwner, FFrameRect);

end;

procedure TFormTitleInfo.DrawTitleIcon(ACanvas: TCanvas; out ARect: TRect);

begin

ARect := GetIconRect;

DrawTitleIcon(FOwner, ACanvas, ARect);

end;

procedure TFormTitleInfo.DrawTitleCaption(ACanvas: TCanvas; var ARect: TRect);

begin

DrawTitleCaption(FOwner, ACanvas, FrameRect, ARect);

end;

end.

[свернуть]

Модуль формы

TFmMain

//******************************************************************************
//  Project: IP76.RU
//  Created: 2024-08-10
//  Article: https://ip76.ru/dark-mode-formD23
//  Описание: Размещение элементов управления в заголовке окна
//            Сохранение системных кнопок окна
//            Без использования Panel, TitleBarPanel и прочих фокусов
//            Тёмная тема Windows 
//******************************************************************************

unit UnMain;

interface

uses
  Winapi.Windows, Winapi.Messages, Winapi.ShellAPi, Winapi.DwmApi,
  System.SysUtils, System.Classes, System.Types,
  Vcl.Graphics, Vcl.Controls, Vcl.Dialogs, Vcl.Forms,
  Vcl.ExtCtrls, Vcl.ImgList, Vcl.StdCtrls, Vcl.Buttons, Vcl.Themes,
  IP76.FormTitleInfo, System.ImageList;

type
  TFmMain = class(TForm)
    ButtonedEdit1: TButtonedEdit;
    ImageList1: TImageList;
    ComboBox1: TComboBox;
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    pbTitle: TPaintBox;
    ComboBox2: TComboBox;
    Image3: TImage;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    Label1: TLabel;
    Image4: TImage;
    Label6: TLabel;
    Bevel1: TBevel;
    Label2: TLabel;
    procedure ButtonedEdit1RightButtonClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure pbTitlePaint(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Label6Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    // Меняется ли сейчас стиль 
    FStyleChanging: Boolean;
    // Информация по заголовку
    FTitleInfo: TFormTitleInfo;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
    procedure WMSetIcon(var Message: TWMSetIcon); message WM_SETICON;
    // Изменились настройки Windows
    procedure WMSettingChange(var Message: TWMSettingChange); 
      message WM_SETTINGCHANGE;
  protected
    procedure WndProc(var Message: TMessage); override;
    // Проверить и установить текущую тему Windows
    procedure CheckWindowTheme;
    // В тёмной ли теме форма
    function FormIsDarkMode: Boolean;
    // Метод при изменении размера, стиля окна
    // Переопределён для косметики - выравнивание контролов в заголовке
    procedure Resize; override;
    // Обработчик при изменении стиля
    procedure DoStyleChange;
  end;

var
  FmMain: TFmMain;

implementation

{$R *.dfm}

 
{TFmMain}

{$Region 'Конструктор/деструктор'}

procedure TFmMain.FormCreate(Sender: TObject);
begin
  FTitleInfo := TFormTitleInfo.Create(Self);
  FTitleInfo.UpdateGlassFrame;
  Caption := 'IP76.RU: Form Tricks 2.2.1';
  Label6.Hint := 'https://ip76.ru/dark-mode-formD23';
  ButtonedEdit1.Text := 'Dark Mode Delphi 12';  
  // Чтобы не было артефактов не-клиентской рамки
  BorderWidth := FTitleInfo.FrameRect.Right;
  // Чтобы убрать стильный заголовок
  StyleElements := [seFont, seClient];
  // Поправка на съеденный заголовок
  if GlassFrame.Enabled then
    Height := Height - GlassFrame.Top;
  // Чтобы в целом нормально отрисовывало
  DoubleBuffered := True;
  
  {$IF CompilerVersion < 34}
  {$ELSE}
  // Чтобы кнопка нормально отрисовывалась
  Button1.DoubleBufferedMode := dbmRequested;
  {$ENDIF}  
  // Выставляем значение стиля рамки
  ComboBox2.ItemIndex := Integer(BorderStyle);
  // Определяем текущую тему ОС
  CheckWindowTheme;
end;

procedure TFmMain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FTitleInfo);
end;

{$EndRegion}

{$Region 'Переключение между темами'}

function TFmMain.FormIsDarkMode: Boolean;
begin
  Result := ComboBox1.ItemIndex>0;
end;

procedure TFmMain.FormShow(Sender: TObject);
begin
  // Меняем выравнивание по правому краю
  Button1.Anchors := [akTop, akRight];
  ComboBox2.Anchors := [akTop, akRight];
  ComboBox1.Anchors := [akTop, akRight];
  ButtonedEdit1.Anchors := [akTop, akRight];
end;

procedure TFmMain.DoStyleChange;
begin
  FStyleChanging := False;
  TFormTitleInfo.SetDarkMode(Handle, FormIsDarkMode);
  FTitleInfo.UpdateGlassFrame;    
//  if FormIsDarkMode then
//    Color := TStyleManager.ActiveStyle.GetStyleColor(scBorder)
//  else
    Color := TStyleManager.ActiveStyle.GetStyleColor(scWindow);
end;

procedure TFmMain.Resize;
var dy: Integer; 
begin
  // В процессе смены стиля он тут вызовется раз несколько
  // А нам нужен последний, после сообщения о смене стиля
  if FStyleChanging then exit;
  // Для минимизированного окна не делаем ничего  
  if WindowState = wsMinimized then exit;
  if WindowState = wsMaximized then
    dy := FTitleInfo.FrameRect.Right div 2
  else
    dy := 0;
  // Выровняли поле заголовка 
  pbTitle.SetBounds(0, dy*2, ButtonedEdit1.Left, -FTitleInfo.FrameRect.Top);
  // Отцентровали компоненты заголовка
  if BorderStyle = bsNone then exit;
  ButtonedEdit1.Top :=(-FTitleInfo.FrameRect.Top-ButtonedEdit1.Height) div 2+dy;
  ComboBox1.Top := ButtonedEdit1.Top;
  ComboBox2.Top := ButtonedEdit1.Top;  
  Button1.Top := ButtonedEdit1.Top;
  Button1.Height := ButtonedEdit1.Height;
  // Генерация события OnResize
  inherited;  
end;
    
procedure TFmMain.ComboBox1Change(Sender: TObject);
begin
  FStyleChanging := 
    (ComboBox1.ItemIndex=0) and TStyleManager.IsCustomStyleActive or
    (ComboBox1.ItemIndex<>0) and not TStyleManager.IsCustomStyleActive; 
  if not FStyleChanging then exit;
  
  if ComboBox1.ItemIndex=0 then
    TStyleManager.TrySetStyle('Windows')
  else
    TStyleManager.TrySetStyle('Windows10 Dark') ;
//    TStyleManager.TrySetStyle('Carbon') ;
//    TStyleManager.TrySetStyle('Windows10 SlateGray') ;
end;

procedure TFmMain.CheckWindowTheme;
begin
  ComboBox1.ItemIndex := Ord(TFormTitleInfo.DarkModeIsEnabled);
  ComboBox1Change(nil);
end;

procedure TFmMain.WMSettingChange(var Message: TWMSettingChange);
begin
  inherited;
  if FStyleChanging then exit;  
  if Message.Section='ImmersiveColorSet' then
    CheckWindowTheme;
end;

{$EndRegion}

{$Region 'Простые методы формы'}

procedure TFmMain.Image1Click(Sender: TObject);
begin
  Icon := TImage(Sender).Picture.Icon;
end;

procedure TFmMain.Label6Click(Sender: TObject);
begin
  ShellExecute(Handle,'open', PChar(Label6.Hint), nil, nil, SW_NORMAL);
end;

procedure TFmMain.Button1Click(Sender: TObject);
begin
  Caption := 'IP76.RU: ' + ButtonedEdit1.Text;
end;

procedure TFmMain.ButtonedEdit1RightButtonClick(Sender: TObject);
begin
  ShowMessage(ButtonedEdit1.TextHint.TrimRight(['.'])+': '+ButtonedEdit1.Text);
end;

procedure TFmMain.CheckBox1Click(Sender: TObject);
var bs: TBorderIcons;
begin
  bs := [];
  if CheckBox1.Checked then bs := bs + [biSystemMenu];
  if CheckBox2.Checked then bs := bs + [biMinimize];
  if CheckBox3.Checked then bs := bs + [biMaximize];
  if CheckBox4.Checked then bs := bs + [biHelp];
  BorderIcons := bs
end;

procedure TFmMain.ComboBox2Change(Sender: TObject);
begin
  BorderStyle := TFormBorderStyle(ComboBox2.ItemIndex);
  FTitleInfo.UpdateGlassFrame;
  Resize;
end;

{$EndRegion}

{$Region 'Обработчики Windows-сообщений'}

procedure TFmMain.WMNCCalcSize(var Message: TWMNCCalcSize);
var Params: PNCCalcSizeParams; M: TMonitor; R: TRect;
begin
  if // Меняется стиль, ничего не вычисляем
    not FStyleChanging and (not FormIsDarkMode or Visible) and
    (FTitleInfo<>nil) and (WindowState <> wsMinimized) and
    Message.CalcValidRects then
  begin
    Params := Message.CalcSize_Params;
    Inc(Params.rgrc[0].Left, FTitleInfo.FrameRect.Right);
    Dec(Params.rgrc[0].Right, FTitleInfo.FrameRect.Right);
    Dec(Params.rgrc[0].Bottom, FTitleInfo.FrameRect.Right);
    if WindowState = wsMaximized then
    begin
      M := Monitor;
      if (M = Screen.PrimaryMonitor) and
        (M.WorkareaRect = M.BoundsRect) then
      begin
        R := TFormTitleInfo.GetTaskBarBounds;
        if not R.IsEmpty then
          if R.Width > R.Height then
            Dec(Params.rgrc[0].Bottom)
          else
            Dec(Params.rgrc[0].Right);
      end;
    end;
  end
  else
    inherited;
end;

procedure TFmMain.WMNCHitTest(var Message: TWMNCHitTest);
var P: TPoint; R: TRect;
begin
  inherited;
  case Message.Result of
    HTCLIENT:
      begin
        P := ScreenToClient(Point(Message.XPos, Message.YPos));
        if P.Y > GlassFrame.Top then exit;
        R := FTitleInfo.GetIconRect;
        if (P.X < R.Right) and
          ((WindowState = wsMaximized) or
           ((P.Y >= R.Top) and (P.Y < R.Bottom))) then
          Message.Result := HTSYSMENU
        else if (P.Y < FTitleInfo.FrameRect.Right) and
          (BorderStyle in [bsSizeable, bsSizeToolWin]) then
          Message.Result := HTTOP
        else
          Message.Result := HTCAPTION;
      end;
    HTMINBUTTON, HTMAXBUTTON, HTCLOSE:
      begin
        Message.Result := HTCAPTION;
        exit;
      end;
  end;
end;

procedure TFmMain.WMActivate(var Message: TWMActivate);
begin
  inherited;
  if pbTitle <> nil then pbTitle.Invalidate;
end;

procedure TFmMain.WMSetText(var Message: TWMSetText);
begin
  inherited;
  if pbTitle <> nil then pbTitle.Invalidate;
end;

procedure TFmMain.WMSetIcon(var Message: TWMSetIcon);
begin
  inherited;
  if pbTitle <> nil then pbTitle.Invalidate;
end;

{$EndRegion}

procedure TFmMain.WndProc(var Message: TMessage);
var StyleChanged: Boolean;
begin
  if HandleAllocated and
    DwmDefWindowProc(Handle, Message.Msg,
    Message.WParam, Message.LParam, Message.Result) then
    exit;
    
  StyleChanged := Message.Msg=CM_CUSTOMSTYLECHANGED;

  inherited;

  if StyleChanged then
  // if Message.Msg = CM_STYLECHANGED then
    DoStyleChange;
end;

procedure TFmMain.pbTitlePaint(Sender: TObject);
var rct: TRect;
begin
  FTitleInfo.DrawTitleIcon(pbTitle.Canvas, rct);
  rct.Left := rct.Right;
  rct.Right := pbTitle.BoundsRect.Right;
  FTitleInfo.DrawTitleCaption(pbTitle.Canvas, rct);
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

//******************************************************************************

// Project: IP76.RU

// Created: 2024-08-10

// Article: https://ip76.ru/dark-mode-formD23

// Описание: Размещение элементов управления в заголовке окна

// Сохранение системных кнопок окна

// Без использования Panel, TitleBarPanel и прочих фокусов

// Тёмная тема Windows

//******************************************************************************

unit UnMain;

interface

uses

Winapi.Windows, Winapi.Messages, Winapi.ShellAPi, Winapi.DwmApi,

System.SysUtils, System.Classes, System.Types,

Vcl.Graphics, Vcl.Controls, Vcl.Dialogs, Vcl.Forms,

Vcl.ExtCtrls, Vcl.ImgList, Vcl.StdCtrls, Vcl.Buttons, Vcl.Themes,

IP76.FormTitleInfo, System.ImageList;

type

TFmMain = class(TForm)

ButtonedEdit1: TButtonedEdit;

ImageList1: TImageList;

ComboBox1: TComboBox;

Button1: TButton;

Image1: TImage;

Image2: TImage;

pbTitle: TPaintBox;

ComboBox2: TComboBox;

Image3: TImage;

CheckBox1: TCheckBox;

CheckBox2: TCheckBox;

CheckBox3: TCheckBox;

CheckBox4: TCheckBox;

Label1: TLabel;

Image4: TImage;

Label6: TLabel;

Bevel1: TBevel;

Label2: TLabel;

procedure ButtonedEdit1RightButtonClick(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure pbTitlePaint(Sender: TObject);

procedure Image1Click(Sender: TObject);

procedure ComboBox2Change(Sender: TObject);

procedure CheckBox1Click(Sender: TObject);

procedure Label6Click(Sender: TObject);

procedure ComboBox1Change(Sender: TObject);

procedure FormShow(Sender: TObject);

private

// Меняется ли сейчас стиль

FStyleChanging: Boolean;

// Информация по заголовку

FTitleInfo: TFormTitleInfo;

procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;

procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;

procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;

procedure WMSetIcon(var Message: TWMSetIcon); message WM_SETICON;

// Изменились настройки Windows

procedure WMSettingChange(var Message: TWMSettingChange);

message WM_SETTINGCHANGE;

protected

procedure WndProc(var Message: TMessage); override;

// Проверить и установить текущую тему Windows

procedure CheckWindowTheme;

// В тёмной ли теме форма

function FormIsDarkMode: Boolean;

// Метод при изменении размера, стиля окна

// Переопределён для косметики - выравнивание контролов в заголовке

procedure Resize; override;

// Обработчик при изменении стиля

procedure DoStyleChange;

end;

var

FmMain: TFmMain;

implementation

{$R *.dfm}

{TFmMain}

{$Region 'Конструктор/деструктор'}

procedure TFmMain.FormCreate(Sender: TObject);

begin

FTitleInfo := TFormTitleInfo.Create(Self);

FTitleInfo.UpdateGlassFrame;

Caption := 'IP76.RU: Form Tricks 2.2.1';

Label6.Hint := 'https://ip76.ru/dark-mode-formD23';

ButtonedEdit1.Text := 'Dark Mode Delphi 12';

// Чтобы не было артефактов не-клиентской рамки

BorderWidth := FTitleInfo.FrameRect.Right;

// Чтобы убрать стильный заголовок

StyleElements := [seFont, seClient];

// Поправка на съеденный заголовок

if GlassFrame.Enabled then

Height := Height - GlassFrame.Top;

// Чтобы в целом нормально отрисовывало

DoubleBuffered := True;

{$IF CompilerVersion < 34}

{$ELSE}

// Чтобы кнопка нормально отрисовывалась

Button1.DoubleBufferedMode := dbmRequested;

{$ENDIF}

// Выставляем значение стиля рамки

ComboBox2.ItemIndex := Integer(BorderStyle);

// Определяем текущую тему ОС

CheckWindowTheme;

end;

procedure TFmMain.FormDestroy(Sender: TObject);

begin

FreeAndNil(FTitleInfo);

end;

{$EndRegion}

{$Region 'Переключение между темами'}

function TFmMain.FormIsDarkMode: Boolean;

begin

Result := ComboBox1.ItemIndex>0;

end;

procedure TFmMain.FormShow(Sender: TObject);

begin

// Меняем выравнивание по правому краю

Button1.Anchors := [akTop, akRight];

ComboBox2.Anchors := [akTop, akRight];

ComboBox1.Anchors := [akTop, akRight];

ButtonedEdit1.Anchors := [akTop, akRight];

end;

procedure TFmMain.DoStyleChange;

begin

FStyleChanging := False;

TFormTitleInfo.SetDarkMode(Handle, FormIsDarkMode);

FTitleInfo.UpdateGlassFrame;

// if FormIsDarkMode then

// Color := TStyleManager.ActiveStyle.GetStyleColor(scBorder)

// else

Color := TStyleManager.ActiveStyle.GetStyleColor(scWindow);

end;

procedure TFmMain.Resize;

var dy: Integer;

begin

// В процессе смены стиля он тут вызовется раз несколько

// А нам нужен последний, после сообщения о смене стиля

if FStyleChanging then exit;

// Для минимизированного окна не делаем ничего

if WindowState = wsMinimized then exit;

if WindowState = wsMaximized then

dy := FTitleInfo.FrameRect.Right div 2

else

dy := 0;

// Выровняли поле заголовка

pbTitle.SetBounds(0, dy*2, ButtonedEdit1.Left, -FTitleInfo.FrameRect.Top);

// Отцентровали компоненты заголовка

if BorderStyle = bsNone then exit;

ButtonedEdit1.Top :=(-FTitleInfo.FrameRect.Top-ButtonedEdit1.Height) div 2+dy;

ComboBox1.Top := ButtonedEdit1.Top;

ComboBox2.Top := ButtonedEdit1.Top;

Button1.Top := ButtonedEdit1.Top;

Button1.Height := ButtonedEdit1.Height;

// Генерация события OnResize

inherited;

end;

procedure TFmMain.ComboBox1Change(Sender: TObject);

begin

FStyleChanging :=

(ComboBox1.ItemIndex=0) and TStyleManager.IsCustomStyleActive or

(ComboBox1.ItemIndex<>0) and not TStyleManager.IsCustomStyleActive;

if not FStyleChanging then exit;

if ComboBox1.ItemIndex=0 then

TStyleManager.TrySetStyle('Windows')

else

TStyleManager.TrySetStyle('Windows10 Dark') ;

// TStyleManager.TrySetStyle('Carbon') ;

// TStyleManager.TrySetStyle('Windows10 SlateGray') ;

end;

procedure TFmMain.CheckWindowTheme;

begin

ComboBox1.ItemIndex := Ord(TFormTitleInfo.DarkModeIsEnabled);

ComboBox1Change(nil);

end;

procedure TFmMain.WMSettingChange(var Message: TWMSettingChange);

begin

inherited;

if FStyleChanging then exit;

if Message.Section='ImmersiveColorSet' then

CheckWindowTheme;

end;

{$EndRegion}

{$Region 'Простые методы формы'}

procedure TFmMain.Image1Click(Sender: TObject);

begin

Icon := TImage(Sender).Picture.Icon;

end;

procedure TFmMain.Label6Click(Sender: TObject);

begin

ShellExecute(Handle,'open', PChar(Label6.Hint), nil, nil, SW_NORMAL);

end;

procedure TFmMain.Button1Click(Sender: TObject);

begin

Caption := 'IP76.RU: ' + ButtonedEdit1.Text;

end;

procedure TFmMain.ButtonedEdit1RightButtonClick(Sender: TObject);

begin

ShowMessage(ButtonedEdit1.TextHint.TrimRight(['.'])+': '+ButtonedEdit1.Text);

end;

procedure TFmMain.CheckBox1Click(Sender: TObject);

var bs: TBorderIcons;

begin

bs := [];

if CheckBox1.Checked then bs := bs + [biSystemMenu];

if CheckBox2.Checked then bs := bs + [biMinimize];

if CheckBox3.Checked then bs := bs + [biMaximize];

if CheckBox4.Checked then bs := bs + [biHelp];

BorderIcons := bs

end;

procedure TFmMain.ComboBox2Change(Sender: TObject);

begin

BorderStyle := TFormBorderStyle(ComboBox2.ItemIndex);

FTitleInfo.UpdateGlassFrame;

Resize;

end;

{$EndRegion}

{$Region 'Обработчики Windows-сообщений'}

procedure TFmMain.WMNCCalcSize(var Message: TWMNCCalcSize);

var Params: PNCCalcSizeParams; M: TMonitor; R: TRect;

begin

if // Меняется стиль, ничего не вычисляем

not FStyleChanging and (not FormIsDarkMode or Visible) and

(FTitleInfo<>nil) and (WindowState <> wsMinimized) and

Message.CalcValidRects then

begin

Params := Message.CalcSize_Params;

Inc(Params.rgrc[0].Left, FTitleInfo.FrameRect.Right);

Dec(Params.rgrc[0].Right, FTitleInfo.FrameRect.Right);

Dec(Params.rgrc[0].Bottom, FTitleInfo.FrameRect.Right);

if WindowState = wsMaximized then

begin

M := Monitor;

if (M = Screen.PrimaryMonitor) and

(M.WorkareaRect = M.BoundsRect) then

begin

R := TFormTitleInfo.GetTaskBarBounds;

if not R.IsEmpty then

if R.Width > R.Height then

Dec(Params.rgrc[0].Bottom)

else

Dec(Params.rgrc[0].Right);

end;

end

else

inherited;

end;

procedure TFmMain.WMNCHitTest(var Message: TWMNCHitTest);

var P: TPoint; R: TRect;

begin

inherited;

case Message.Result of

HTCLIENT:

begin

P := ScreenToClient(Point(Message.XPos, Message.YPos));

if P.Y > GlassFrame.Top then exit;

R := FTitleInfo.GetIconRect;

if (P.X < R.Right) and

((WindowState = wsMaximized) or

((P.Y >= R.Top) and (P.Y < R.Bottom))) then

Message.Result := HTSYSMENU

else if (P.Y < FTitleInfo.FrameRect.Right) and

(BorderStyle in [bsSizeable, bsSizeToolWin]) then

Message.Result := HTTOP

else

Message.Result := HTCAPTION;

end;

HTMINBUTTON, HTMAXBUTTON, HTCLOSE:

begin

Message.Result := HTCAPTION;

exit;

end;

procedure TFmMain.WMActivate(var Message: TWMActivate);

begin

inherited;

if pbTitle <> nil then pbTitle.Invalidate;

end;

procedure TFmMain.WMSetText(var Message: TWMSetText);

begin

inherited;

if pbTitle <> nil then pbTitle.Invalidate;

end;

procedure TFmMain.WMSetIcon(var Message: TWMSetIcon);

begin

inherited;

if pbTitle <> nil then pbTitle.Invalidate;

end;

{$EndRegion}

procedure TFmMain.WndProc(var Message: TMessage);

var StyleChanged: Boolean;

begin

if HandleAllocated and

DwmDefWindowProc(Handle, Message.Msg,

Message.WParam, Message.LParam, Message.Result) then

exit;

StyleChanged := Message.Msg=CM_CUSTOMSTYLECHANGED;

inherited;

if StyleChanged then

// if Message.Msg = CM_STYLECHANGED then

DoStyleChange;

end;

procedure TFmMain.pbTitlePaint(Sender: TObject);

var rct: TRect;

begin

FTitleInfo.DrawTitleIcon(pbTitle.Canvas, rct);

rct.Left := rct.Right;

rct.Right := pbTitle.BoundsRect.Right;

FTitleInfo.DrawTitleCaption(pbTitle.Canvas, rct);

end;

end.

[свернуть]

Тёмная тема в Delphi XE 7

Delphi XE 7 создавалась в эпоху Windows 7. Никакой тёмной темы не было и в помине. Однако, не всё так печально. Как сделать настоящую тёмную тему в Delphi XE 7 расскажу тут: Трюки с формой 2.2.2: Тёмная тема Windows в Delphi XE7

Скачать

Друзья, спасибо за внимание!

Исходник (zip) 373 Кб. Delphi XE 12

Исполняемый файл (zip) 1.44 Мб (Скомпилирован в XE 12)

5 3 голоса

Рейтинг статьи

0 комментариев

Старые

Новые Популярные

Межтекстовые Отзывы

Посмотреть все комментарии