В этой статье мы рассмотрим расширение функционала стандартного календаря TCalendar и добавим поддержку раскраски требуемых дней в календаре. Расширение будет продемонстрировано с использованием нового подхода разработки компонента в FireMonkey.
В результате этой статьи вы получите готовый модуль, который будет достаточно добавить в ваш проект, чтобы использовать расширенную версию календаря с раскраской дней без необходимости создания отдельного компонента календаря.
Статья базируется на версии RAD Studio Delphi Seattle 10. Для ранних версий она не применима.
Код рабочего проекта: Delphi Seattle XE10
Содержание
- 1 Общая стратегия
- 2 Определение набора расширенных настроек TCalendar
- 3 Хелперы для удобства обращения к новым свойствам
- 4 Создание интерфейса демонстрационного проекта
- 5 Создание и регистрация нового представления на базе TStyledCalendar
- 6 Реализация раскраски дней
- 7 Обновление дней, при изменений настроек отображения
- 8 Повторное использование
Перед тем, как читать эту статью, я советую ознакомиться с предыдущими статьями по теме нового подхода разработки компонента FireMonkey “Контрол – Модель – Презентация”, иначе все здесь покажется непонятным и запутанным 🙂
- Новый подход разработки компонентов FireMonkey “Контрол – Модель – Презентация”. Часть 1
- Новый подход разработки компонентов FireMonkey “Контрол – Модель – Презентация”. Часть 2. TEdit с автозавершением
- Создание нативных представлений для iOS. TSpinBox и UIStepper. Часть 3
Общая стратегия
В RAD Studio XE10 Seattle для стилевой презентации календаря TCalendar была добавлена функциональность по получению содержимых компонентов представления календаря. Это позволяет нам получить доступ к любому контролу, представляющему день месяца по дате, год, кнопки переключения, и тд. Имея доступ к контролу дня, можно полностью менять его настройки отображения текста: шрифт, цвет, а так же помимо этого добавлять в него свои дополнительные контролы для подсветки и контурного обведения дней.
Сразу продемонстрирую конечный вид нашего расширенного календаря:
Перед тем, как приступить непосредственно к разработке, очертим общую стратегию. Она заключается на главной идеи использования нового подхода разработки компонентов в FireMonkey — «Контрол — Модель — Презентация». Основная идея заключается в том, чтобы разделить реализацию компонента на составные части, кубики, которые в дальнешйем можно будет заменять на другие аналогичные. Подробнее об этом написано в первой части. Для TCalendar это уже сделано и мы можем расширять уже готовые кубики TCalendar под свои нужды.
В этой статье нас будет интересовать стилевая презентация календаря TStyledCalendar, которая и осуществляет отображение календаря так, как мы видем в среде. На ее основе мы сделаем новую презентацию и добавим в нее поддержку раскраски дней недели, используя новое API добавленное в XE10. Помимо этого дополнительно обеспечим набор новых свойств для существующего календаря для указания цветов расскраски произвольных дней недели и выходных. Приступим.
Определение набора расширенных настроек TCalendar
В этой части нам требуется определить набор новых настроек отображения календаря. Поскольку наш расширенный календарь должен уметь подсвечивать выходные дни и произвольные дни, то естественно добавить:
- ShowWeekends: Boolean — Включить/Выключить подсветку выходных дней
- ShowEvents: Boolean — Включить/Выключить подстветку произвольно указанных дней
- WeekendsColor: TAlphaColor — Цвет подсветки выходных дней
- EventsColor: TAlphaColor — Цвет подсветки произвольных дней
- 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;
Создание интерфейса демонстрационного проекта
Перед тем, как мы приступим к созданию новой презентации, создадим рабочий стенд для тестирования нашего календаря с новой функциональностью.
Мы добавили две галки для включения и отключения подсветки выходных дней и любых других. По нажатию на галки, мы обновляем значения параметров календаря:
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 в списке не пересоздаются. То есть этот метод только обновляет текст в каждом итеме.
Перекрыв этот метод в нашей презентации мы можем добавить к базовому заполнению дополнительные действия:
- Добавить задний фон интересных для нас дней
- Изменить параметры шрифта интересных для нас дней.
В нашем примере мы будем добавлять только задний фон и не будем менять параметры шрифта.
Алгоритм раскраски дней
Добавляем отдельный метод по добавлению заднего фона для каждой даты из нашего списка дат 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;
- Пробегаемся по всем итемам
- Ищем и удаляем в каждом итеме окружности с названием «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 — содержит значение параметра.
Теперь когда все готово, запускаем проект и любуемся проделанной работой.
Повторное использование
Теперь осталось поговорить о том, как использовать уже готовые юниты в новых или уже существующих проектах. Для добавления этой функциональности достаточно добавить два модуля в ваш проект:
- FMX.CalendarHolidayDays.Style.pas — файл с новой презентаций
- FMX.Calendar.Helpers.pas — файл с вспомогательными функциями для работы с новыми параметрами отображения календаря
Вот и все, как вы можете заметить, этот подход дает очень удобное расширения функциональности без создания и установки в систему новых компонентов.
Код рабочего проекта: Delphi Seattle XE10
Many thanks from Greece
You are welcome, thank you