Delphi XE5: Китайский календарь для Android.

Работа по изложенному в прошлом посте плану движется к первой контрольной точке и, видимо, скоро все желающие смогут ознакомиться с началом нашей книги по Synapse. Говорю «нашей» так как пишем мы её вдвоем. Посмотрим, что в итоге получится. Однако, я не оставляю попыток (когда имеется возможность) покопаться и в Delphi XE5. Всё-таки эту версию Delphi я ожидал намного больше, чем XE4 и как-то не хорошо получается — ждал-ждал, дождался и забыл :). Вот сегодня я и решил написать небольшую программку для Android — Китайский календарь.

Идея программы родилась под воздействием ежегодного всеобщего кипиша относительно Нового Года. Думаю, что в большинстве семей ежегодно просыпается нездоровый интерес к тому какой будет будущий год по Китайскому календарю.

Все же сталкивались с подобными диалогами:

Однако реже возникает вопрос о том когда именно наступит тот самый Китайский Новый Год? А его дата является плавающей и напрямую зависит от новолуний.  Вот я и решил написать небольшую программку, которая будет определять по заданной дате чей будет год по Китайскому календарю, какие элемент и цвет этому году будут соответствовать и т.д. В общем, ничего серьезного и претендующего на конкурсную работу (кстати, Вы уже зарегистрировались на сайте конкурса?)- просто первые более-менее осознанные шаги в Delphi XE5 по разработке приложения под Android.

Чтобы было более-менее понятно о чем ниже пойдет речь, а я не копипастил сюда чуть более, чем наполовину статьи из вики, я рекомендую Вам ознакомиться с двумя статьями, касающихся Китайского календаря и Китайского же гороскопа. Надо сказать, довольно занимательное чтиво, особенно, что касается соответствий элементов и цветов…как-то запутано получается :) Смотрите:

Гороскоп определяет такое соответствие элементов и цветов:

• Дереву — зелёный,
• Воде — синий/чёрный,
• Металлу — белый (золотой),
• Земле — охра (коричневый),
• Огню — красный

А вот соответствие по календарю:

• Дереву — синий/зеленый,
• Воде — чёрный,
• Металлу — белый (золотой),
• Земле — желтый,
• Огню — красный

Как бы там ни было, пусть цветовая гамма останется на совести китайцев и китайских астрологов в частности. Я же в программе буду использовать цвета Китайского календаря. Собственно, цветовая гамма — это мелочь, по сравнению с тем, что будет далее.

Теперь приступим непосредственно к работе над программой. Открываем Delphi XE5, создаем новый проект мобильного приложения (в качестве шаблона я для начала выбран «Blank Applcation». Интерфейс программы пока будет очень простым:

На форме расположены следующие элементы (смотрим сверху вниз):

1. TCalendarEdit — компонент для выбора даты для которой мы будем рассчитывать все данные
2. TImage — в него мы будем выводить изображение животного из Китайского зодиака, которое будет соответствовать указанному в дате году
3. 5 TLabel с префиксом lb в названии — метки для вывода всей необходимой информации

Последняя метка (lbThisDate) пригодится нам для точного определения к какому году относится заданная дата. Как я писал выше (а Вы могли узнать из статьи вики), наступлением нового года признается второе, считая от зимнего солнцестояния (21—22 декабря), новолуние, которое происходит соответственно не раньше 21 января и не позже 20 февраля.

То есть может получиться так, что задается дата, скажем, 1 января 2012 года. Для нас это уже новый год и вроде как должен быть год черного Дракона, а по-китайски — это ещё год белого Кролика, т.к. ещё не произошло второе новолуние после зимнего солнцестояния. Вот так вот.

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

В программе мы будем копировать из этого изображения необходимый нам кусок и выводить в TImage. Хранить картинку будем в виде ресурса, поэтому выбираем в главном меню пункт «Project — Resources and Images..» и добавляем новый ресурс как показано на рисунке ниже:

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

unit ChinCal.Math;
 
interface
 
uses System.Classes, System.SysUtils, System.Types,FMX.Graphics;
 
resourcestring
  {животные}
  rsRat = 'Крысы';
  rsBull = 'Быка';
  rsTiger = 'Тигра';
  rsRabbit = 'Кролика';
  rsDragon = 'Дракона';
  rsSnake = 'Змеи';
  rsHorse = 'Лошади';
  rsSheep = 'Овцы';
  rsMonkey = 'Обзьяны';
  rsCock = 'Петуха';
  rsDog = 'Собаки';
  rsPig = 'Свиньи';
  {Элементы}
  rsTree = 'Дерево';
  rsFire= 'Огонь';
  rsLand= 'Земля';
  rsMetal= 'Металл';
  rsWater= 'Вода';
 
  rsTree2 = 'Деревянно';
  rsFire2= 'Огоненно';
  rsLand2= 'Земляно';
  rsMetal2= 'Металлическо';
  rsWater2= 'Водяно';
 
  {Цвета}
  rsblueGreen= 'Синий';
  rsRed= 'Красный';
  rsYellow= 'Желтый';
  rsWhite= 'Белый';
  rsBlack= 'Черный';
 
  rsblueGreen2= 'Сине';
  rsRed2= 'Красно';
  rsYellow2= 'Желто';
  rsWhite2= 'Бело';
  rsBlack2= 'Черно';
  {окончания для цветов и элементов}
  rsSuffix_1 = 'й';
  rsSuffix_2 = 'го';
 
const
  cImageWidth = 103;
  cImageHeight = 103;
 
  cAnimals : array [0..11] of string =(rsRat,    rsBull,  rsTiger, rsRabbit,
                                       rsDragon, rsSnake, rsHorse, rsSheep,
                                       rsMonkey, rsCock,  rsDog,   rsPig);
 
  cColors: array [0..4,0..1] of string =((rsblueGreen, rsblueGreen2),
                                          (rsRed,       rsRed2),
                                          (rsYellow,    rsYellow2),
                                          (rsWhite,     rsWhite2),
                                          (rsBlack,     rsBlack2));
 
  cElements:array [0..4,0..1] of string = ((rsTree,  rsTree2),
                                      (rsFire,  rsFire2),
                                      (rsLand,  rsLand2),
                                      (rsMetal, rsMetal2),
                                      (rsWater, rsWater2));
[...]

По два варианта названий цветов и элементов, как Вы уже, наверное, могли догадаться, потребуются нам для того, чтобы можно было выводить на форму названия тех или иных элементов календаря в разных падежах, например, чтобы можно было вывести строку с цветом как «Красный«, а название года как «Год Красного Огненного Петуха» и т.д.

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

1. Получать дату
2. Рассчитывать все необходимые параметры и выдавать их нам

Назовем этот класс TChineseCal. Этот класс после того как задана дата должен будет вернуть следующую информацию:

1. Название животного
2. Название элемента
3. Название цвета и его значение
4. Полное название года, например, «Год Синей Деревянной Лошади»
5. Дату начала года по Китайскому календарю

Начнем с самого простого — определим все названия. В классе этим будет заниматься одна единственная процедура:

type
  TChineseCal = class
  private
    [...]
    FAnimal: string;
    FColorStr: string;
    FColor: TAlphaColor;
    FElement: string;
    FFullName: string;
    [...]
    procedure CalcParams(AYear: word; var AAnimal, AColorStr, AElement,
      AFullName: string; var AColor: TAlphaColor);
    [...]
  public
    constructor Create;
    destructor Destroy; override;
    property FullName: string read FFullName;
    property Animal: string read FAnimal;
    property ColorStr: string read FColorStr;
    property Color: TAlphaColor read FColor;
    property Element: string read FElement;
    [...]
  end;
 
procedure TChineseCal.CalcParams(AYear: word; var AAnimal, AColorStr, AElement,
  AFullName: string; var AColor: TAlphaColor);
var
  i: integer;
  AAnimalIdx, AElementIdx: integer;
begin
  i := (AYear + 116) mod 60;
  AAnimalIdx := i mod 12;
  AElementIdx := i div 2 mod 5;
  AAnimal := cAnimals[AAnimalIdx];
  AColorStr := cColors[AElementIdx, 0];
  case AElementIdx of
    0:AColor := TAlphaColorRec.Blue;
    1:AColor := TAlphaColorRec.Red;
    2:AColor := TAlphaColorRec.Yellow;
    3:AColor := TAlphaColorRec.White;
    4:AColor := TAlphaColorRec.Black;
  end;
  AElement := cElements[AElementIdx, 0];
  AFullName := GetFullName(AAnimalIdx, AElementIdx);
end;

Функция GetFullName по заданным индексам животного (от 0 до 11) и элемента (от 0 до 4) собирает строку с полным названием года и выглядит следующим образом:

function TChineseCal.GetFullName(AAnimalIdx, AElementIdx: integer): string;
begin
  case AAnimalIdx of
    0, 5 .. 8, 10, 11:
      result := Format(cYear, [cColors[AElementIdx, 1], rsSuffix_1,
                               cElements[AElementIdx, 1], rsSuffix_1, 
                               cAnimals[AAnimalIdx]]);
    1 .. 4, 9:
      result := Format(cYear, [cColors[AElementIdx, 1], rsSuffix_2,
                               cElements[AElementIdx, 1], rsSuffix_2, 
                               cAnimals[AAnimalIdx]]);
  end;
end;

Теперь переходим к более-менее интересной части — расчёт начала нового года по Китайскому календарю. Напомню, что нам надо вычислить второе, считая от зимнего солнцестояния, новолуние, которое происходит не раньше 21 января и не позднее 20 февраля.

В самом простом случае нам надо пройтись в цикле по 30 суткам интервала и определить есть ли в этих сутках новолуние или нет, если есть, то это и будет начало нового года.

Остается вопрос — как определить новолуние? Имея некоторый опыт расчёта всяких астрономических величин и явлений, типа восходов/заходов, склонений Солнца и прочего,  могу сказать, что рассчитать с большой точностью новолуние, имея под руками только Delphi и ничего более — адский труд, куча потраченного времени и не менее большая куча проблем. И самая мелкая, но тем не менее серьезная проблемка в этой задаче — учёт часовых поясов и местного времени, т.к. скажем у меня в Омске новолуние может наблюдаться в 21 января в 23:00 по местному времени, а в каком-нибудь Катманду оно будет 22 января в 01:15 и Китайский Новый Год у нас наступит, соответственно, в разные дни.   Поэтому я решил воспользоваться инфой из Википедии и рассчитать новолуние безотносительно часовых поясов, т.е. в самом худшем случае программка будет выдавать дату нового года с погрешностью в 1 день, что не так уж и страшно для простенькой программки, а время сэкономит.

Порывшись у себя в загашниках, а также, прошерстив интернет на предмет готовых алгоритмов решения задачи, нашел как минимум три решения задачи два из которых (с использованием вспомогательных таблиц со всякими поправочными коэффициентами) давали в итоге погрешность в 2 и более суток, что не есть хорошо. А вот третье мне уже один раз пригодилось. Был раньше (лет эдак 9 назад) в Сети сайт home.att.net (жаль, что сайт умер) и там автор выкладывал довольно оригинальные, а главное простые и достаточно точные решения астрономических задачек, выполненных на языке программирования Zeno. Если Вы перейдете по ссылке и посмотрите как выглядит простейшая программка на Zeno, то поймете, что перевести код с Zeno на Delphi элементарно. Так вот одной из задач на том сайте была задача по определению лунных фаз и возраста Луны. Фазы нам не потребуются, а вот возраст в самый раз. Безбожно упростив код я получил вот такую функцию определения возраста Луны в заданный день:

function TChineseCal.GetMoonDay(ADate: TDate): integer;
 
  function normalize(v: real): real;
  begin
    v := v - floor(v);
    if v < 0 then
      v := v + 1;
    result := v
  end;
 
var
  year, month, day: word;
  AG: single;
  YY, MM, K1, K2, K3, JD: integer;
  IP: single;
begin
  DecodeDate(ADate, year, month, day);
  // calculate the Julian date at 12h UT
  YY := year - floor((12 - month) / 10);
  MM := month + 9;
  if (MM >= 12) then
    MM := MM - 12;
  K1 := floor(365.25 * (YY + 4712));
  K2 := floor(30.6 * MM + 0.5);
  K3 := floor(floor((YY / 100) + 49) * 0.75) - 38;
  // for dates in Julian calendar
  JD := K1 + K2 + day + 59;
  if (JD > 2299160) then
    JD := JD - K3; // for Gregorian calendar
  // % calculate moon's age in days
  IP := normalize((JD - 2451550.1)/29.530588853);
  AG := IP * 29.53;
  if AG > 29.53 then
    AG := AG - 29.53;
  result := floor(AG);
end;

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

function TChineseCal.GetStartDay: TDate;
var
  StartDate: TDate;
  EndDate: TDate;
  CurrentDate: TDate;
  MoonDay: integer;
begin
  result := 0;
  StartDate := EncodeDate(FYear, 1, 21);
  EndDate := EncodeDate(FYear, 2, 20);
  CurrentDate := StartDate;
  while CurrentDate <= EndDate do
  begin
    MoonDay := GetMoonDay(CurrentDate);
    if MoonDay = 0 then
    begin
      result := CurrentDate;
      Exit;
    end;
    CurrentDate := IncDay(CurrentDate);
  end;
end;

Здесь мы в цикле перебираем все даты с 21 января по 20 февраля и ищем новолуние. Следующий момент — определить к какому году по Китайскому календарю относится заданная дата. Здесь все просто — если задается дата раньше, чем 21 января, то по-китайски это будет все ещё предыдущий год, т.е. 19.01.2014 — это всё ещё 19.01.2013. Поэтому пишем ещё одну простенькую функцию:

function TChineseCal.GetThisDateInfo: string;
var
  AAnimal, AColorStr, AElement, AFullName: string;
  AColor: TAlphaColor;
begin
  if FStartDay > FDate then
  begin
    CalcParams(FYear-1, AAnimal, AColorStr, AElement, AFullName, AColor);
    result := AFullName;
  end
  else
    result := FFullName;
end;

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

type
  TChineseCal = class
  private
    FYear: word;
    FDate: TDate;
    [...]
    FStartDay: TDate;
    [...]
    FThisDay: string;
    FOnChange: TNotifyEvent;
    procedure CalcParams(AYear: word; var AAnimal, AColorStr, AElement,
      AFullName: string; var AColor: TAlphaColor);
    function GetMoonDay(ADate: TDate): integer;
    function GetStartDay: TDate;
    procedure SetDate(const Value: TDate);
    function GetFullName(AAnimalIdx, AElementIdx: integer): string;
    function GetThisDateInfo: string;
  public
    constructor Create;
    destructor Destroy; override;
    [...]
    property StartDay: TDate read FStartDay;
    property Date: TDate read FDate write SetDate;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;
 
procedure TChineseCal.SetDate(const Value: TDate);
var AMonth, ADay: word;
begin
  if FDate <> Value then
  begin
    FDate := Value;
    DecodeDate(FDate, FYear, AMonth, ADay);
    CalcParams(FYear, FAnimal, FColorStr, FElement, FFullName, FColor);
    FStartDay := GetStartDay;
    FThisDay := GetThisDateInfo;
    if Assigned(FOnChange) then
      FOnChange(self)
  end;
end;

Как только пользователь поменяет дату, то будут рассчитаны все необходимые параметры и вызовется событие OnChange по которому мы и поймем, что требуется обновить сведения в программе. Теперь нам осталось только вывести изображение в TImage. Так как у нас все изображения хранятся в одном ресурсе, то будем копировать нужный нам кусок и передавать его в TImage. Сделать это можно так:

//получаем изображение из ресурсов
procedure TChineseCal.LoadResource;
var
  rs: TResourceStream;
begin
  rs := TResourceStream.Create(HInstance, cResName, RT_RCDATA);
  try
    FBitmap.LoadFromStream(rs);
  finally
    rs.Free;
  end;
end;
 
//копируем часть изображения в битмап
procedure TChineseCal.LoadBitmap(Bitmap: TBitmap);
var
  SrcBtm: TBitmap;
  i, imgX, imgY: integer;
  ImageRect: TRect;
begin
  if not Assigned(Bitmap) then
    Exit;
  i := ((FYear + 116) mod 60 mod 12);
  imgY := i div 4;//определяем столбец с нужным изображением
  imgX := i mod 4;//определяем строку с нужным изображением
  ImageRect := TRect.Create(imgX * cImageWidth, imgY * cImageHeight,
    imgX * cImageWidth + cImageWidth, imgY * cImageHeight + cImageHeight);
  SrcBtm := TBitmap.Create;
  try
    SrcBtm.Width := ImageRect.Width;
    SrcBtm.Height := ImageRect.Height;
    SrcBtm.CopyFromBitmap(FBitmap, ImageRect, 0, 0);
    Bitmap.Assign(SrcBtm);
  finally
    SrcBtm.Free;
  end;
end;

Вот и весь класс. Теперь снова возвращаемся к форме и главному модулю нашего приложения и дописываем его. Задаем переменную и добавляем обработчик события OnChange нашего класса:

 Tfmain = class(TForm)
   [...]
  private
    Calendar : TChineseCal;
    procedure DoCalendarChange(Sender: TObject);
  public
    { Public declarations }
  end;

Создавать объект Calendar будем в OnCreate формы, а «убивать» в OnDestroy:

procedure Tfmain.FormCreate(Sender: TObject);
begin
  Calendar := TChineseCal.Create;
  Calendar.OnChange:=DoCalendarChange;
  GregorianDateChange(self)
end;
 
procedure Tfmain.FormDestroy(Sender: TObject);
begin
  Calendar.Free;
end;

Метод DoCalendarChange выглядит следующим образом:

procedure Tfmain.DoCalendarChange(Sender: TObject);
begin
  lbAnimal.Text:=Calendar.FullName;
  lbElement.Text:=Calendar.Element;
  lbStartDay.Text:=DateToStr(Calendar.StartDay);
  lbColor.Text:=Calendar.ColorStr;
  lbThisDate.Text:=Calendar.ThisDateInfo;
  lbColor.FontColor:=Calendar.Color;
  Calendar.LoadBitmap(imgAnimal.Bitmap);
end;

Обработчик события OnChange у TCalendarEdit и того проще:

procedure Tfmain.GregorianDateChange(Sender: TObject);
begin
  Calendar.Date:=GregorianDate.Date;
end;

Вот и вся программка, а точнее первый её вариант. Теперь можно подключить свой Android-девайс к компьютеру и проверить работу программы, определив, например, чей будет 2014 год и когда он наконец-то наступит у китайских коллег:

Как видите, это будет год синей деревянной лошади, а заданная дата (19/01/2014) относится все ещё к году черной водяной змеи, т.к. китайский новый год наступит только 31 января 2014 года, что, собственно, и подтверждают сведения в Википедии. Вот такой вот китайский календарик у меня получился. Теперь можно навешать на программку всяких рюшечек типа анимаций при смене картинок, сменить стиль и т.д. и т.п., но это уж как-нибудь в следующий раз.
Всем удачных разработок в Delphi XE5 и до новых встреч на страницах блога webdelphi.ru.

Книжная полка

	Автор: Антон Григорьев Название: О чем не пишут в книгах по Delphi Описание: Рассмотрены малоосвещенные вопросы программирования в Delphi. Описаны методы интеграции VCL и API. Показаны внутренние механизмы VCL и приведены примеры вмешательства в эти механизмы. Рассмотрено использование сокетов в Delphi: различные режимы их работы, особенности для протоколов TCP и UDP и др.
	Автор: Юрий Магда Название: Разработка приложений Microsoft Office 2007 в Delphi Описание: Описаны общие подходы к программированию приложений MS Office. Даны программные методы реализации функций MS Excel, MS Word, MS Access и MS Outlook в среде Delphi.