Есть мнение, что сделать чёрным системное меню какого-либо элемента Windows в Delphi не получится. Даже сменив тему всей ОС. Если меняем тему окна на тёмную, внутреннее меню TEdit останется светлым. Что делать? Как приручить дракона?
Во-первых, можно назначить собственный PopupMenu и отрисовать его. Но тогда придётся полностью продублировать пункты всех системных меню всех элементов (окно, все TEdit, TMemo и т.д.), сделать отрисовку для всех выпадающих меню в проекте. Чтобы продублировать, необходимо получить описатель меню того же TEdit. Для этого нужно осуществить ряд танцев с бубном, связанных с CBT-ловушкой (ниже). Короче, мрак.
Во-вторых, конечно можно использовать какой-нибудь хороший (платный) тёмный VCL-стиль. Но не хочется. Потому что разбухает исполняемый модуль (и платный), и совсем не всегда нужно прям всё из стиля.
Получается, что есть только один путь. Ставить CBT-ловушку (CBT-ловушка по-русски), отлавливать события HCBT_CREATEWND, HCBT_DESTROYWND, связанные с окном «#32768» (класс меню), подменять отрисовку, либо дублировать меню. Но когда я этим призанялся, вдруг стало так лень…
Возможно, это продолжение разговора про тёмную тему Windows. Как получится.
Ловушка: TSysPopupStyleHook
TSysPopupStyleHook — это ловушка для контекстного меню (Vcl.SysStyles). Является наследником TSysStyleHook (Vcl.Themes). Также существует класс TCustomStyleEngine (Vcl.Themes), который понимает список зарегистрированных наследников TSysStyleHook, и знает, для каких классов окон они предназначены. Если список не пуст, TCustomStyleEngine регистрирует CBT-ловушку, отслеживает создание или уничтожение нужных окон и взаимодействует с соответствующей стилевой ловушкой.
Таким образом, TCustomStyleEngine занимается ровно тем, чем пришлось бы заниматься руками. И чем заниматься лень. По сути, связка TCustomStyleEngine и TSysStyleHook — это инкапсуляция легального Winapi. А это основа архитектуры Delphi. Поэтому, решение через наследование TSysPopupStyleHook — это изящный, лёгкий и легальный путь достижения цели.
Поэтому будем делать наследника и пытаться зарегистрировать его в системе, чтобы иметь возможность отрисовать пункты меню, как мы этого пожелаем.
Создадим класс наследника от системной ловушки контекстного меню и переопределим два метода, отвечающих за отрисовку пункта и фона меню:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
uses Vcl.Themes, Vcl.SysStyles; type // Ловушка для отрисовки чёрного выпадающего меню TBlackSysPopupStyleHook = class(TSysPopupStyleHook) protected // Отрисовать пункт выпадающего меню procedure DrawItem(Canvas: TCanvas; Index: Integer; ItemRect: TRect; ItemText: String; State: TSysPopupItemState; Style: TSysPopupItemStyle); override; // Отрисовать фон всего выпадающего меню procedure PaintBackground(Canvas: TCanvas); override; end; |
Рисуем фон: PaintBackground
Для отрисовки фона делаем очень простые манипуляции:
|
1 2 3 4 5 |
procedure TBlackSysPopupStyleHook.PaintBackground(Canvas: TCanvas); begin Canvas.Brush.Color := clBlack; Canvas.FillRect(Canvas.ClipRect); end; |
Таким образом мы избавимся от белого ободка вокруг и прочих рудиментов неклиентской части окна меню.
Тут можно было бы нарисовать какой-нибудь битмап на всю ширь окна меню. Фоновую картинку с логотипом компании. Или замостить кирпичами. Метод DrawItem придётся, правда, реализовывать несколько иным образом, чтобы не затирать изображение, но это тема на целую статью.
Немного о параметрах в DrawItem:
| Canvas: TCanvas |
| Холст, на котором должна происходить вся отрисовка. |
| Index: Integer |
| Индекс элемента меню внутри ловушки. Элемент доступен, как Items[Index]. Сам тип элемента спрятан в приватной секции ловушки: private type TSysPopupItem = class, поэтому объявлять экземпляр этого типа смысла нет. Зато у него есть ряд интересных свойств, доступ к которым можно получить, обращаясь через Items[Index]. |
| ItemRect: TRect |
| Область отрисовки пункта меню |
| ItemText: String |
| Текст для отрисовки пункта меню |
| State: TSysPopupItemState |
| Множество текущих состояний пункта меню: TSysPopupItemState = set of (isHot, isDisabled, isChecked, isDefault); isHot — мышь над пунктом, надо подсветить. Остальное можно получить из свойств Items[Index] isDisabled — пункт неактивен, надо засерить; isChecked — на пункте галочка, либо кружок (если он RadioItem); isDefault — является пунктом меню по умолчанию, надо выделить жирным. |
| Style: TSysPopupItemStyle |
| Стиль пункта меню: TSysPopupItemStyle = (isNormal, isSep, isDropDown) Дубли информации из свойств Items[Index] isSep — это разделитель, рисовать линию, подсвечивать на мышь не надо isDropDown — есть подменю, рисуем треугольник, либо что-то подходящее isNormal — не разделитель, нет подменю |
Свойства для элемента Items[Index] ловушки:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
// Прямоугольник пункта меню Items[Index].ItemRect: TRect; // Пункт меню неактивен Items[Index].Disabled: Boolean; // Пункт меню является разделительной полосой Items[Index].Separator: Boolean; // Пункт меню владеет подменю Items[Index].HasSubMenu: Boolean; // Пункт меню помечен галочкой Items[Index].Checked: Boolean; // Пункт меню ведёт себя, как RadioButton Items[Index].RadioCheck: Boolean; // Пункт меню является пунктом по умолчанию Items[Index].DefaultItem: Boolean; // Заголовок пункта меню Items[Index].Text: String; // Связанный с элементом VCL-пункт меню Items[Index].VCLMenuItem: TMenuItem; // Описатель системного битмапа, связанный с пунктом меню // Для того, чтобы получить битмап, настроенный в Vcl, // обращаемся к Items[Index].VCLMenuItem Items[Index].Bitmap: HBITMAP; |
В этой реализации метода DrawItem не учитывается отрисовка битмапов и BiDiMode. При желании это можно легко допилить. Но это очень сильно увеличит код. Поэтому, чтобы не усложнять жизнь, вот базовая реализация, которая покрывает почти все проблемы:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 |
procedure TBlackSysPopupStyleHook.DrawItem(Canvas: TCanvas; Index: Integer; ItemRect: TRect; ItemText: String; State: TSysPopupItemState; Style: TSysPopupItemStyle); // Нарисовать текст procedure DrawText(const Text: string; const Rect: TRect); var R: TRect; begin R := Rect; Winapi.Windows.DrawText(Canvas.Handle, PChar(Text), Length(Text), R, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or DT_EXPANDTABS or DT_EDITCONTROL); end; // Проверить пользовательскую отрисовку, // и, если есть, выполнить её function HasCustomDrawItem: Boolean; var MenuItem: TMenuItem; ItemState: TOwnerDrawState; begin MenuItem := Items[Index].VCLMenuItem; Result := MenuItem<>nil; if not Result then exit; if Assigned(MenuItem.OnDrawItem) then MenuItem.OnDrawItem(MenuItem, Canvas, ItemRect, isHot in State) else if Assigned(MenuItem.OnAdvancedDrawItem) then begin ItemState := []; if isDisabled in State then ItemState := ItemState + [odDisabled]; if isHot in State then ItemState := ItemState + [odSelected]; MenuItem.OnAdvancedDrawItem(MenuItem, Canvas, ItemRect, ItemState); end else Result := False; end; // Нарисовать комбинацию клавиш, если есть procedure DrawShortCutText; var MenuItem: TMenuItem; S: string; R: TRect; begin MenuItem := Items[Index].VCLMenuItem; if (MenuItem=nil) or (MenuItem.ShortCut=0) then exit; S := ShortCutToText(MenuItem.ShortCut); R := ItemRect; R.Right := ItemRect.Right; R.Left := R.Right - 14 - Canvas.TextWidth(S); DrawText(S, R); end; var Text: string; TextRect: TRect; IsSeperator: Boolean; IsSubMenu: Boolean; IsChecked: Boolean; IsRadioItem: Boolean; begin // Если у VCL пункта меню уже есть своя отрисовка, рисуем и выходим if HasCustomDrawItem then exit; // Определяем текущее состояние пункта меню IsSeperator := Style=isSep; IsSubMenu := Style=isDropDown; IsChecked := Items[Index].Checked; IsRadioItem := Items[Index].RadioCheck; // Закрашиваем прямоугольник пункта меню if (isHot in State) and not IsSeperator then Canvas.Brush.Color := clGray else Canvas.Brush.Color := clBlack; Canvas.FillRect(ItemRect); // Формируем прямоугольник для текста Text := ItemText; TextRect := ItemRect; InflateRect(TextRect, -2, 0); // Небольшой отступ TextRect.Left := TextRect.Left+TextRect.Height+2; if IsSubMenu then TextRect.Right := TextRect.Right-4- TextRect.Height div 2; // Пункт по умолчанию делаем жирным if isDefault in State then Canvas.Font.Style := [fsBold] else Canvas.Font.Style := []; // Цвет текста в зависимости от состояния пункта if (isDisabled in State) then if isHot in State then Canvas.Font.Color := RGB(5,5,5) else Canvas.Font.Color := RGB(150,150,150) else if isHot in State then Canvas.Font.Color := RGB(250,250,250) else Canvas.Font.Color := clWhite; // Если имеем дело с разделителем if IsSeperator then begin // Рисуем почти белую линию Canvas.Pen.Color := RGB(250,250,250); Canvas.MoveTo(TextRect.Left, TextRect.CenterPoint.Y); Canvas.LineTo(TextRect.Right, TextRect.CenterPoint.Y); end else // Иначе рисуем текст DrawText(Text, TextRect); // Если есть подменю, рисуем треугольник if IsSubMenu then DrawText('►', Rect(ItemRect.Right - TextRect.Height div 2 - 6, TextRect.Top, ItemRect.Right, TextRect.Bottom)); // Если пункт с галкой, рисуем либо галку, либо точку if IsChecked then begin if IsRadioItem then DrawText('●', Rect(ItemRect.Left+4, ItemRect.Top, TextRect.Left, ItemRect.Bottom)) else DrawText('✔', Rect(ItemRect.Left+4, ItemRect.Top, TextRect.Left, ItemRect.Bottom)); end; // Если пункт с горячими клавишами, то нарисуем комбинацию DrawShortCutText; end; |
Регистрация ловушки
Чтобы ловушка могла осуществлять своё предназначение, её надо зарегистрировать. Для этих целей в классе TCustomStyleEngine существуют несколько методов. Нам понадобятся эти:
|
1 2 3 4 |
class procedure RegisterSysStyleHook(SysControlClass: String; SysStyleHookClass: TSysStyleHookClass); class procedure UnRegisterSysStyleHook(SysControlClass: String; SysStyleHookClass: TSysStyleHookClass); |
Предположим, что у нас есть на форме CheckBox1: TCheckBox, включённое состояние которого регистрирует ловушку, выключенное — убирает регистрацию.
|
1 2 3 4 5 6 7 8 9 |
procedure TForm1.CheckBox1Click(Sender: TObject); begin if CheckBox1.Checked then TCustomStyleEngine.RegisterSysStyleHook('#32768', TBlackSysPopupStyleHook) else TCustomStyleEngine.UnRegisterSysStyleHook('#32768', TBlackSysPopupStyleHook); end; |
Здесь мы регистрируем нашу ловушку для системного класса меню ‘#32768’. Следует отметить, что если кто-то потом зарегистрирует свою ловушку для этого класса, наша ловушка будет выкинута из списка. Аналогично и обратное, если кто-то уже занял место за этим классом, наша регистрация убьёт его.
Сделали, запускаем, не работает.
Особенности и хитрости
Дело в том, что по умолчанию у нас используется текущий стиль Windows. И Delphi считает, что если у нас работает стандартный системный стиль, то никаких ловушек регистрировать не надо. Справедливо, между прочим, считает. Не надо плодить ловушки в системе. Опасно это.
Можно зарегистрировать и сделать активным какой-то стиль, например Light. Тогда у нас появится стиль, ради которого надо регистрировать CBT-ловушку, потому что он несистемный. Но мы не хотим стилей вообще, и нас вполне всё устраивает, только меню хотим чёрное.
Механизм начинает работать, если у нас есть хотя бы один зарегистрированный стиль, отличный от системного. Без стилей механизм не работает. Стилей мы не хотим. Системный стиль уже есть.
Как быть?
Как приручить дракона?
Всё просто. Является ли стиль системным определяется простым сравнением с уже созданным внутри TStyleManager стилем по умолчанию. А давайте создадим ещё один системный стиль и установим его активным? Например, в конструкторе формы.
|
1 2 3 4 5 6 7 |
procedure TForm1.FormCreate(Sender: TObject); begin // Создаём и делаем активным ещё один системный стиль TStyleManager.SetStyle(TUxThemeStyle.Create); // Устанавливаем нашу ловушку CheckBox1Click(CheckBox1); end; |
И всё волшебным образом взлетело! В интерфейсе не изменилось ровным счётом ничего, кроме цвета контекстного меню. Контекстное меню теперь стало тотально чёрным. Везде. Если снять галку с Black Popup Menu Enabled, то меню станет обычным, для сравнения.
Так теперь выглядит системное меню TEdit.
Так выглядит своё меню. Пункты меню имеют соответствующе галки, точки и жирность.
А так меню выглядит у значка в трее.
И, наконец, системное меню окна тоже чёрное.
Применение
Возможно, нам надо только слегка изменить вид контекстного меню. Заявив тем самым о своей неповторимости. Использовать стили не хотим, они легко узнаваемы.
Или нам не нужно менять всё, у нас просто другой подход к интерфейсу. Например, вместо иконок, мы используем Юникод или ещё более тотально — Font Awesome. Использовать символы вместо картинок хорошо тем, что их можно отрисовать любым цветом и начертанием. Однако, возможности их пропихнуть в меню на место иконки — нет. Тут и пригодится такой подход — переопределить системную стилевую ловушку.
Или, например, если наше приложение хочет поддерживать цветовые схемы. Как минимум, тёмную и светлую. Но для этого не хотим применять стили. А ещё может быть зелёная или синяя темы. Корпоративные цвета. Разные направления. Разные настроения.
Одним словом, как будут выглядеть контекстные меню, зависит только от нашей фантазии. Системное меню элемента Windows оказывается можно покрасить на любой вкус.
Надеюсь, немного подвинул горизонты возможного. Остальное — дело творчества.
Скачать
Друзья, спасибо за внимание!
Исходник (zip) 23 Кб. Delphi XE 7
Исполняемый файл (zip) 973 Kб (Скомпилирован в XE 7)
Благодарю! Кое что умел ранее по этой теме, но вижу, что есть чему еще поучиться!
Не за что )))
Здравствуйте! Как применить Ваш код для изменения меню в чужом окне? И как добавить иконки из ImageList для рисования в меню?
Здравствуйте, Алексей!
Извиняюсь за задержку с ответом.
Этот код работает исключительно в рамках своего приложения, для чужого неприменим. Чтобы менять меню в чужом окне, надо работать на системном уровне через CBT_Hook и иметь весь тот гемор, о котором говорил в начале статьи. Овчинка выделки не стоит, только если за неё не заплатили приличные деньги.
Чтобы что-то дополнительно рисовать в меню, включая иконки из ImageList, необходимо расширить этим функционалом метод TBlackSysPopupStyleHook.DrawItem. В нём мы рисуем всё, что нам угодно.