Календарь с подсветкой дней на базе TCalendar без создания нового компонента

CalendarWithEventsВ этой статье мы рассмотрим расширение функционала стандартного календаря TCalendar и добавим поддержку раскраски требуемых дней в календаре. Расширение будет продемонстрировано с использованием нового подхода разработки компонента в FireMonkey.

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

Статья базируется на версии RAD Studio Delphi Seattle 10. Для ранних версий она не применима.

Код рабочего проекта: Delphi Seattle XE10


Перед тем, как читать эту статью, я советую ознакомиться с предыдущими статьями по теме нового подхода разработки компонента FireMonkey “Контрол – Модель – Презентация”, иначе все здесь покажется непонятным и запутанным 🙂

  1. Новый подход разработки компонентов FireMonkey “Контрол – Модель – Презентация”. Часть 1
  2. Новый подход разработки компонентов FireMonkey “Контрол – Модель – Презентация”. Часть 2. TEdit с автозавершением
  3. Создание нативных представлений для iOS. TSpinBox и UIStepper. Часть 3

Общая стратегия

В RAD Studio XE10 Seattle для стилевой презентации календаря TCalendar была добавлена функциональность по получению содержимых компонентов представления календаря. Это позволяет нам получить доступ к любому контролу, представляющему день месяца по дате, год, кнопки переключения, и тд. Имея доступ к контролу дня, можно полностью менять его настройки отображения текста: шрифт, цвет, а так же помимо этого добавлять в него свои дополнительные контролы для подсветки и контурного обведения дней.

Сразу продемонстрирую конечный вид нашего расширенного календаря:

Обычный TCalendar с поддержкой раскраски дней

Обычный TCalendar с поддержкой раскраски дней

Перед тем, как приступить непосредственно к разработке, очертим общую стратегию. Она заключается на главной идеи использования нового подхода разработки компонентов в FireMonkey — «Контрол — Модель — Презентация».  Основная идея заключается в том, чтобы разделить реализацию компонента на составные части, кубики, которые в дальнешйем можно будет заменять на другие аналогичные. Подробнее об этом написано в первой части. Для TCalendar это уже сделано и мы можем расширять уже готовые кубики TCalendar под свои нужды.

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

Определение набора расширенных настроек TCalendar

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

  1. ShowWeekends: Boolean — Включить/Выключить подсветку выходных дней
  2. ShowEvents: Boolean — Включить/Выключить подстветку произвольно указанных дней
  3. WeekendsColor: TAlphaColor — Цвет подсветки выходных дней
  4. EventsColor: TAlphaColor — Цвет подсветки произвольных дней
  5. Events: TArray<TDateTime> — Набор дат, которые мы хотим подсветить.

Аналогично статье о добавлении поддержки автозаполнения для TEdit, эти данные мы будем хранить в Model.Data.

Например, чтобы сохранить в модели значение параметра ShowWeekends, достаточно написать такой код:

Calendar.Model.Data['ShowWeekends'] := True;

А чтобы получить:

Result := Calendar.Model.Data['ShowWeekends'].AsBoolean;

Обратите внимание, что Model.Data работает со значениями типа TValue. А мы в примере выше, помещаем логическое значение True вместо TValue. Уловка заключается в том, что для базовых типов для TValue перегружен оператор присваивания и в этом примере логическое True будет обернуто в TValue автоматически.

Чтобы упростить для нас работу с этими настройками в уже рабочих проектах и избежать работы с TValue, можно создать специальный хелпер для существующего класса TCalendar и добавить уже привычные для нас свойства. Этим мы сейчас и займемся.

Хелперы для удобства обращения к новым свойствам

Добавим класс хелпер TCalendarModelHelpers для стандартного календаря TCalendar. Разместим его в отдельном модуле FMX.Calendar.Helpers.pas. В его реализации нет ничего сложного. Лишь добавление одноименных названию новых параметров свойств и написание геттеров и сеттеров.

unit FMX.Calendar.Helpers;

interface

uses
  System.Rtti, FMX.Calendar, System.UITypes;

type
  TCalendarModelHelpers = class helper for TCalendarModel
  public const
    DefaultEventsColor = $FFB8E3AB;
    DefaultWeekendsColor = $FFFEB1AF;
  private
    function GetShowEvents: Boolean;
    procedure SetShowEvents(const Value: Boolean);
    function GetShowWeekends: Boolean;
    procedure SetShowWeekends(const Value: Boolean);
    function GetEventsColor: TAlphaColor;
    procedure SetEventsColor(const Value: TAlphaColor);
    function GetWeekendsColor: TAlphaColor;
    procedure SetWeekendsColor(const Value: TAlphaColor);
  public
    property ShowEvents: Boolean read GetShowEvents write SetShowEvents;
    property ShowWeekends: Boolean read GetShowWeekends write SetShowWeekends;
    property EventsColor: TAlphaColor read GetEventsColor write SetEventsColor;
    property WeekendsColor: TAlphaColor read GetWeekendsColor write SetWeekendsColor;
  end;

implementation

{ TCalendarModelHelpers }

function TCalendarModelHelpers.GetEventsColor: TAlphaColor;
var
  Value: TValue;
begin
  Value := Data['EventsColor'];
  if Value.IsEmpty or Value.TryAsType<TAlphaColor>(Result) then
    Result := DefaultEventsColor;
end;

function TCalendarModelHelpers.GetShowEvents: Boolean;
begin
  Result := Data['ShowEvents'].AsBoolean;
end;

function TCalendarModelHelpers.GetShowWeekends: Boolean;
begin
  Result := Data['ShowWeekends'].AsBoolean;
end;

function TCalendarModelHelpers.GetWeekendsColor: TAlphaColor;
var
  Value: TValue;
begin
  Value := Data['WeekendsColor'];
  if Value.IsEmpty or not Value.TryAsType<TAlphaColor>(Result) then
    Result := DefaultWeekendsColor;
end;

procedure TCalendarModelHelpers.SetEventsColor(const Value: TAlphaColor);
begin
  Data['EventsColor'] := TValue.From<TAlphaColor>(Value);
end;

procedure TCalendarModelHelpers.SetShowEvents(const Value: Boolean);
begin
  Data['ShowEvents'] := Value;
end;

procedure TCalendarModelHelpers.SetShowWeekends(const Value: Boolean);
begin
  Data['ShowWeekends'] := Value;
end;

procedure TCalendarModelHelpers.SetWeekendsColor(const Value: TAlphaColor);
begin
  Data['WeekendsColor'] := TValue.From<TAlphaColor>(Value);
end;

end.

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

Calendar1.Model.ShowEvents := CBDisplayEvents.IsChecked;
Calendar1.Model.ShowWeekends := CBDisplayWeekends.IsChecked;

Обратите внимание, что верхние две строчки кода, полностью эквивалентны:

  Calendar1.Model.Data['ShowEvents'] := CBDisplayEvents.IsChecked;
  Calendar1.Model.Data['ShowWeekends'] := CBDisplayWeekends.IsChecked;

Создание интерфейса демонстрационного проекта

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

UI стенда тестирования календаря

UI стенда тестирования календаря

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

procedure TMainForm.CBDisplayEventsChange(Sender: TObject);
begin
  Calendar1.Model.ShowEvents := CBDisplayEvents.IsChecked;
end;

procedure TMainForm.CBDisplayWeekendsChange(Sender: TObject);
begin
  Calendar1.Model.ShowWeekends := CBDisplayWeekends.IsChecked;
end;

ListBox Events будет содержать список дат, которые требуется выделить в календаре. Для передачи списка выделенных дней в календарь будем использовать следующий код:

procedure TMainForm.UpdateEvents;
var
  Events: TArray<TDateTime>;
  Item: string;
  I: Integer;
begin
  SetLength(Events, LBEvents.Count);
  for I := 0 to LBEvents.Count - 1 do
    Events[I] := StrToDateTime(LBEvents.Items[I]);

  Calendar1.Model.Data['Events'] := TValue.From<TArray<TDateTime>>(Events);
end;

Собираем все даты из списка в единый массив Events и передаем этот массив в модель Calendar1.Model.Data[‘Events’].

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

procedure TMainForm.BtnAddEventsClick(Sender: TObject);
begin
  LBEvents.Items.Add(DEEvent.Text);
  UpdateEvents;
end;

procedure TMainForm.BtnDeleteEventsClick(Sender: TObject);
begin
  if LBEvents.ItemIndex <> -1 then
    LBEvents.Items.Delete(LBEvents.ItemIndex);
  UpdateEvents;
end;

Теперь наш стенд готов, приступим к созданию новой презентации для нашего календаря.

Создание и регистрация нового представления на базе TStyledCalendar

Для хранения нашего нового представления лучше создать отдельный файл. В дальнейшем можно будет его легко повторно использовать в других проектах, путем простого добавления файла к вашему проекту. Назовем файл: FMX.CalendarHolidayDays.Style.pas

Создаем новое представление. В качестве базового класса выберем TStyledCalendar – это стилевая презентация TCalendar. Именно она используется по умолчанию во всех TCalendar. Назовем наш класс представления TStyledCalendarWithHolidayDays. Приставка Styled — означает, что эта презентация использует стили и не нативная. Название представления может быть любым и ни как не влияет на дальнейшее использование в TCalendar.

Ниже представлен минимальный код по созданию и подмены стандартной реализации стилевого календаря TStyledCalendar на нашу TStyledCalendarWithHolidayDays.

unit Unit1;

interface

uses
  FMX.Calendar, FMX.Calendar.Style, FMX.Controls.Model;

type

  TStyledCalendarWithHolidayDays = class(TStyledCalendar)
  end;

implementation

uses
  FMX.Presentation.Factory, FMX.Controls, FMX.Presentation.Style;

initialization
  TPresentationProxyFactory.Current.Replace(TCalendar, TControlType.Styled, TStyledPresentationProxy<TStyledCalendarWithHolidayDays>);
finalization
  TPresentationProxyFactory.Current.Replace(TCalendar, TControlType.Styled, TStyledPresentationProxy<TStyledCalendar>);
end.

Регистрация представления

Подмена презентаций происходит в секции инициализации и выглядит так:

initialization
  TPresentationProxyFactory.Current.Replace(TCalendar, TControlType.Styled, TStyledPresentationProxy<TStyledCalendarWithHolidayDays>);

Суть метода в том, чтобы заменить уже зарегистрированную стилевую презентацию для TCalendar на нашу TStyledCalendarWithHolidayDays.

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

finalization
  TPresentationProxyFactory.Current.Replace(TCalendar, TControlType.Styled, TStyledPresentationProxy<TStyledCalendar>);
end.

Проверка факта подмены представления

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

procedure TMainForm.BtnCheckPresentationNameClick(Sender: TObject);
begin
  if Calendar1.Presentation <> nil then
    ShowMessage(Calendar1.Presentation.ClassName)
  else
    ShowMessage('TCalendar doesn''t have presentation');
end;

Запустите проект и нажмите на клавишу «Check Presentation Name». Если все ок, то сообщение выдаст вам название класса вашего представления «TStyledCalendarWithHolidayDays»:

Проверка класса представления

Проверка класса представления

Теперь все готово для того, чтобы реализовать функциональность по раскраске дней в календаре.

Реализация раскраски дней

Отображение дней в календаре построено на компоненте TListBox с многоколоночным режимом. Когда пользователь переключает месяц или год, стилевая презентация календаря вызывает метод FillDays. Задача этого методы обновить тексты в элементах списка Days: TListBox. Обратите внимание, что сами TListBoxItem в списке не пересоздаются. То есть этот метод только обновляет текст в каждом итеме.

Перекрыв этот метод в нашей презентации мы можем добавить к базовому заполнению дополнительные действия:

  1. Добавить задний фон интересных для нас дней
  2. Изменить параметры шрифта интересных для нас дней.

В нашем примере мы будем добавлять только задний фон и не будем менять параметры шрифта.

Алгоритм раскраски дней

Добавляем отдельный метод по добавлению заднего фона для каждой даты из нашего списка дат Events. В качестве заднего фона будем использовать TCircle. Вы можете выбрать любой другой компонент на ваш вкус.

procedure TStyledCalendarWithHolidayDays.PaintEvents;
var
  Events: TArra<TDateTime>;
  Event: TDateTime;
  DayItem: TListBoxItem;
begin
  // Проверяем, что модель содержит список дат, и что этот список - массив дат
  if Model.Data['Events'].IsType<TArray<TDateTime>> then
  begin
    // Извлекаем массив дат из модели
    Events := Model.Data['Events'].AsType<TArray<TDateTime>>;;
    // Для каждой даты находим соответствующий элемент <strong>TListBoxItem</strong> списка
    for Event in Events do
    begin
      DayItem := TryFindDayItem(Event);
      // Если элемент есть (текущий месяц совпадает с месяцем и годом даты события, добавляем задний фон)
      if DayItem <> nil then
        CreateBackground(DayItem, Model.EventsColor);
    end;
  end;
end;

TryFindDayItem — это новое API из TStyledCalendar, позволяющее найти по дате соответствующий дню TListBoxItem.

Теперь посмотрим метод создания заднего фона CreateBackground. Он принимает два параметра — итем дня, в который мы будем добавлять наш контрол/ фон TCircle и цвет заливки фона.

procedure TStyledCalendarWithHolidayDays.CreateBackground(ADayItem: TListBoxItem; const AColor: TAlphaColor);
var
  Hightlight: TCircle;
begin
  Hightlight := TCircle.Create(nil);
  Hightlight.Name := 'HightlightBackground';
  Hightlight.HitTest := False;
  Hightlight.Align := TAlignLayout.Contents;
  Hightlight.Margins.Rect := TRectF.Create(3, 3, 3, 3);
  Hightlight.Stroke.Kind := TBrushKind.None;
  Hightlight.Fill.Color := AColor;
  ADayItem.InsertObject(0, Hightlight);
end;

Создаем окружность, вставляем ее в итем дня. Обратите внимание, что мы именно вставляем в первую позицию, вместо того, чтобы использовать задание родителя через Parent. Потому что, чем объект дальше от нас, тем у него меньше индекс. Задний фон должен находится позади всего. Если мы будем использовать Parent для задания родителя, то в этом случае наша окружность полностью перекроет текст внутри итема.

Обратите внимание на задание свойства Name. По скольку итемы TListBoxItem, соответствующие дням месяца не удаляются, нам нужна процедура по очистки наших окружностей из элементов. Чтобы у нас была возможность каким-то способом идентифицировать фоны в итемах, мы помечаем их через свойство Name и всем окружностям даем название «HightlightBackground«.

Чтобы удалить окружности, используем следующую процедуру:

procedure TStyledCalendarWithHolidayDays.RemoveDaysBackgrounds;

  procedure RemoveBackground(ADayItem: TListBoxItem);
  var
    I: Integer;
    Background: TControl;
  begin
    for I := ADayItem.ControlsCount - 1 downto 0 do
      if ADayItem.Controls[I].Name = 'HightlightBackground' then
      begin
        Background := ADayItem.Controls[I];
        Background.Parent := nil;
        Background.Free;
      end;
  end;

var
  I: Integer;
  DayItem: TListBoxItem;
begin
  if Days <> nil then
    for I := 0 to Days.Count - 1 do
    begin
      DayItem := Days.ListItems[I];
      RemoveBackground(DayItem);
    end;
end;
  1. Пробегаемся по всем итемам
  2. Ищем и удаляем в каждом итеме окружности с названием «HightlightBackground«

Когда все вспомогательные процедуры готов, перекрываем метод FillDays, вызываемый для обновления числе в таблице:

procedure TStyledCalendarWithHolidayDays.FillDays;
begin
  inherited;
  // Paint holidays
  RemoveDaysBackgrounds;
  if Model.ShowWeekends then
    PaintWeekends;
  if Model.ShowEvents then
    PaintEvents;
end;

Не забываем, что для того, чтобы использовать Model.ShowWeekends, нужно не забыть подключить модуль с хелперами FMX.Calendar.Helpers, который мы сделали в самом начале статьи. На текущий момент процедура раскраски выходных пока еще не готово. Перейдем к ее реализации

Алгоритм раскраски выходных дней

Попробуйте самостоятельно написать метод получения итемов, соответствующих выходным дням в месяце. А вот мой вариант:

procedure TStyledCalendarWithHolidayDays.PaintWeekends;
var
  DayItem: TListBoxItem;
  FirstDate: TDateTime;
  FirstDay: Word;
  LWeek: Integer;
  WeekendDate: TDateTime;
  FirstWeekendDay: Integer;
  MonthDaysCount: Word;
  SaturdayDay: Word;
  SundayDay: Word;
begin
  FirstDate := StartOfTheMonth(Self.Date);
  FirstDay := DayOfTheWeek(FirstDate);
  MonthDaysCount := DaysInMonth(FirstDate);
  FirstWeekendDay := DaysPerWeek - FirstDay + 1;

  for LWeek := 0 to 4 do
  begin
    // Saturday
    SaturdayDay := FirstWeekendDay - 1 + LWeek * DaysPerWeek;
    if InRange(SaturdayDay, 1, MonthDaysCount) then
    begin
      WeekendDate := RecodeDay(FirstDate, SaturdayDay);
      DayItem := TryFindDayItem(WeekendDate);
      if DayItem <> nil then
        CreateBackground(DayItem, Model.WeekendsColor);
    end;
    // Sunday
    SundayDay := FirstWeekendDay + LWeek * DaysPerWeek;
    if InRange(SundayDay, 1, MonthDaysCount) then
    begin
      WeekendDate := RecodeDay(FirstDate, SundayDay);
      DayItem := TryFindDayItem(WeekendDate);
      if DayItem <> nil then
        CreateBackground(DayItem, Model.WeekendsColor);
    end;
  end;
end;

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

Обновление дней, при изменений настроек отображения

При изменении данных в модели Model.Data, контрол TCalendar отсылает уведомление об этом в презентацию в виде сообщения MM_DATA_CHANGED с сообщением типа TDispatchMessageWithValue<TDataRecord>. Перехватываем сообщение в презентации:

  TStyledCalendarWithHolidayDays = class(TStyledCalendar)
  protected
    { Messages from Model }
    /// <summary>Notification about changing value of DataSource of a model of <c>PresentedControl</c> </summary>
    procedure MMDataChanged(var AMessage: TDispatchMessageWithValue<TDataRecord>); message MM_DATA_CHANGED;

В коде проверяем, что изменилось один из наших параметров:

procedure TStyledCalendarWithHolidayDays.MMDataChanged(var AMessage: TDispatchMessageWшthValue<TDataRecord>);
begin
  if SameText(AMessage.Value.Key, 'ShowWeekends') or
     SameText(AMessage.Value.Key, 'ShowEvents') or
     SameText(AMessage.Value.Key, 'EventsColor') or
     SameText(AMessage.Value.Key, 'WeekendsColor') or
     SameText(AMessage.Value.Key, 'Events') then
   FillCalendar
  else
    inherited;
end;
  • Value.Key — содержит название параметра.
  • Value.Value — содержит значение параметра.

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

Повторное использование

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

  1. FMX.CalendarHolidayDays.Style.pas — файл с новой презентаций
  2. FMX.Calendar.Helpers.pas — файл с вспомогательными функциями для работы с новыми параметрами отображения календаря

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

Код рабочего проекта: Delphi Seattle XE10

Календарь с подсветкой дней на базе TCalendar без создания нового компонента: 2 комментария

Добавить комментарий для Yaroslav Brovin Отменить ответ

Ваш e-mail не будет опубликован. Обязательные поля помечены *