Давно, очень давно я увлекся написанием одной программки, которая была призвана помочь мне не забыть о важной дате, о Дне Рождении друга и т.п. Есть несколько версий программки, которые даже распространялись через инет, но не в том суть. Когда я начинал писать ту программку, первое с чем мне пришлось столкнуться - Даты.
Думаю не имеет смысла сейчас описывать тип TDateTime, кому интересно может заглянуть в запылившуюся на полке книжку либо воспользоваться Гуглом. А я тем временем, предлагаю рассмотреть модуль, который состоит из нескольких простейших казалось бы функций и процедур. Тем не менее некоторые из них придумались не за 5 и не за 10 минут. А отлаживались и того дольше. Но тем не менее прошли обкатку в реальных условиях использования и даже методом рефакторинга приведены к вполне разумному виду для понимания.
Итак привожу код модуля:
////////////////////////////////////////////////////////////////////////////////
// ПРОЦЕДУРЫ И ФУНЦКЦИИ ДЛЯ РАБОТЫ С ДАТОЙ И ВРЕМЕНЕМ //
// АВТОР: МУКОМЕЛО ЕВГЕНИЙ БОГДАНОВИЧ ака XIO //
// Дата создания: 09072009 //
// Дата изменения: 25072009 //
////////////////////////////////////////////////////////////////////////////////
unit xDateWork;
interface
Const
tbdTypeDay = 0;
tbdTypeHour = 1;
tbdTypeMinute = 2;
tbdTypeSecond = 3;
Function GetAgeOf(XDate: TDateTime): integer;
Function GetDaysCountOf(XDate: TDateTime): integer;
Function GetJubiOf(XDate: TDateTime): Byte;
Function GetZadiak(HB_Date_L:TDateTime):integer;
Function TimeBeforeDate(DateX: TDateTime; ResType: Byte): Integer;
implementation
Uses DateUtils, SysUtils;
////////////////////////////////////////////////////////////////////////////////
//
// ПРОЦЕДУРА: GetDateInfo
//
// НАЗНАЧЕНИЕ: Выдает количество дней оставшихся до Дня Рождения, и возраст
// человека.
//
// ПАРАМЕТРЫ:
// HB_DATE - Дата Рождения человека.
// AGE - Возраст человека.
// Days_Before_HB - Количество дней оставшихся до Дня Рождения.
// Jubilee - Будет юбилейная дата или нет. 1/0
//
Procedure GetDateInfo(HB_DATE:TDateTime; var AGE:Integer; var Days_Before_HB:Integer; var Jubilee:Byte);
Var
Year_HB: TDateTime; //Год рождения
Year_Now: TDateTime; //Текущий год
CountYear: TDateTime; //Количество лет
Now_Date: TDateTime; //Текущая дата
CountYearI : Double; //тоже самое по сути.. может без неё обойдемся???
InkHB_Have: byte; //Индикатор того что Д.Р. в этом году уже был. (0-не прошёл, 1-прошёл)
StrDate: String[20]; //Дата рождения
StrDate2: String[20]; //Текущая дата
StrYear: String[20]; //текущий год
StrYear2: String[20]; //текущий год + 1
Ubl1: Integer; // возраст в формате Integer.
Ubl2: String[20]; //для перевода Double в String и затем его в Integer...
IntYear: integer; //переводим год в целое число что бы инкриментировать его.
I: integer; // счетчик цикла.
DTDate: TDateTime; //для преобразования строки в дату.
CountDays1: Integer; //Количество дней до Нового года если ДР будет в след. году.
CountDays2: Integer; //количество дней от начала года до ДР
SumCount : Integer; //сумма количества дней, то есть количество дней оставшихся до ДР.
begin
//Задаем начальные значения.
Now_Date := DateOf(Now());
Year_HB := YearOf(HB_Date);
Year_Now := YearOf(Now());
CountYear := Year_Now - Year_HB;
CountYearI := CountYear;
//Если месяц д. рождения > текущего
//Тогда возраст в этом году ещё не прибавился на 1
If MonthOf(HB_DATE) > MonthOf(Now_Date) then
begin
CountYearI := CountYearI - 1;
InkHB_Have := 0
end //если месяц др = текущему и день рождения больше текущего числа тогда в этом году др ещё не было.
else If (MonthOf(HB_DATE) = MonthOf(Now_Date)) and (DayOf(HB_DATE) > DayOf(Now_Date)) then
begin
CountYearI := CountYearI - 1;
InkHB_Have := 0
end
else //иначе ДР уже произошел
InkHB_Have := 1;
// AGE := CountYearI; // текущий возможный возраст.
Ubl2 := FloatToStr(CountYearI);//переведем вещественное число в строку.
Ubl1 := StrToInt(Ubl2); //строковое вещественное в целое.
AGE := Ubl1; // текущий возможный возраст.
StrDate := DateToStr(HB_Date);
StrDate2 := DateToStr(Now_Date);
StrYear := '';
//если День Варенья ещё не произошел в этом году
If InkHB_Have = 0 then
begin // у даты рождения подменяем год на текущий. для использования функции DaysBetween
For I:=10 DownTo 7 do
Delete(StrDate,I,1);
For I:=7 to 10 do
StrDate := StrDate + StrDate2[I];
DTDate := StrToDate(StrDate);
Days_Before_HB := DaysBetween(Now_Date,DTDate);
end
else
begin
For I:=7 to 10 do
StrYear := StrYear + StrDate2[I]; //Записываем год текущий в виде строки.
IntYear := StrToInt(StrYear); //Переводим текущий год в целое число.
Inc(IntYear); //Инкрементируем.
StrYear2 := IntToStr(IntYear); //Снова переводим в строку. уже инкрементированный вариант.
For I:=10 DownTo 7 do
Delete(StrDate,I,1);
For I:= 1 to 4 do //в дате рождения подменяем год текущим годом.
StrDate := StrDate + StrYear[I];
StrDate2 := DateToStr(HB_DATE);// переводим значение Даты Рождения в формат строки.
For I:=10 DownTo 7 do //Подменяем в дате Рождения год на текущий + 1
Delete(StrDate2,I,1);
For I:= 1 to 4 do
StrDate2 := StrDate2 + StrYear2[I];
DTDate := StrToDate(StrDate);
//Далее обходим возможные ошибки связанные с тем, в каком году мы находимся...
// Получаем количество дней до Нового Года
CountDays1 := DaysBetween(Now_Date, StrToDate('31.12.'+StrYear));
Try
//пытаемся получить количество дней до ДР от начала следующего года...
CountDays2 := DaysBetween(StrToDate('01.01.'+StrYear2), StrToDate(StrDate2));
Except
//если год не высокостный обрабатываем исключение связанное с ДР 29 Февраля.
//И все же получаем количетсво дней до ДР.
StrDate2[2] := '8';
CountDays2 := DaysBetween(StrToDate('01.01.'+StrYear2), StrToDate(StrDate2));
End;
SumCount := CountDays1 + CountDays2; // получаем сумму количества дней оставшихся до ДР
Days_Before_HB := CountDays1+CountDays2;
end;
If Now_Date = DTDate then //ДР наступил уже сегодня.
Days_Before_HB := 0; //и дней осталось нуль.
if Days_Before_HB = 0 then //раз дней осталось нуль значит ДР уже наступил или прошёл и возраст правильный.
If (((Ubl1) mod 5) = 0)or(Ubl1 = 16)or(Ubl1 = 18) then
Jubilee := 1
else
Jubilee := 0
else //иначе ДР ещё только будет, и надо прибавить 1 чтобы понять будет Юбилей или просто ДР.
If (((Ubl1+1) mod 5) = 0)or(Ubl1+1 = 16)or(Ubl1+1 = 18) then
Jubilee := 1
else
Jubilee := 0;
end;
////////////////////////////////////////////////////////////////////////////////
//
// ФУНКЦИЯ: GetAgeOf
//
// НАЗНАЧЕНИЕ: Возвращает только возраст по дате рождения.
//
// ПАРАМЕТРЫ:
// XDate - Дата рождения, возраст от которой нужно расчитать.
//
Function GetAgeOf(XDate: TDateTime): integer;
var
Age_L: Integer;
Days_L: Integer;
Jubi: Byte;
begin
GetDateInfo(XDate,Age_L,Days_L,Jubi);
GetAgeOf := Age_L;
end;
////////////////////////////////////////////////////////////////////////////////
//
// ФУНКЦИЯ: GetDaysCountOf
//
// НАЗНАЧЕНИЕ: Возвращает только количество дней до даты рождения.
//
// ПАРАМЕТРЫ:
// XDate - Дата рождения, до которой считаем колличество оставшихся дней.
//
Function GetDaysCountOf(XDate: TDateTime): integer;
var
Age_L: Integer;
Days_L: Integer;
Jubi: Byte;
begin
GetDateInfo(XDate,Age_L,Days_L,Jubi);
GetDaysCountOf := Days_L;
end;
////////////////////////////////////////////////////////////////////////////////
//
// ФУНКЦИЯ: GetJubiOf
//
// НАЗНАЧЕНИЕ: Определяет, будет юбилей в этом году или нет.
//
// ПАРАМЕТРЫ:
// XDate - Дата рождения которую проверяем на юбилейность.
//
Function GetJubiOf(XDate: TDateTime): Byte;
var
Age_L: Integer;
Days_L: Integer;
Jubi: Byte;
begin
GetDateInfo(XDate,Age_L,Days_L,Jubi);
GetJubiOf := Round(Jubi);
end;
////////////////////////////////////////////////////////////////////////////////
//
// ФУНКЦИЯ: GetZadiak
//
// НАЗНАЧЕНИЕ: По дате рождения, определяет знак задиака.
//
// ПАРАМЕТРЫ:
// HB_Date_L - Дата рождения, по которой будет определён знак задиака.
//
Function GetZadiak(HB_Date_L:TDateTime):integer;
Var
Month: Integer;
Day: Integer;
begin
Try
Month := MonthOf(HB_Date_L);
Day := DayOf(HB_Date_L);
If (Month=3) and (Day>=21) or (Month=4) and (Day<=20) then
GetZadiak := 1; //Овен
If (Month=4) and (Day>=21) or (Month=5) and (Day<=21) then
GetZadiak := 2; //Телец
If (Month=5) and (Day>=22) or (Month=6) and (Day<=21) then
GetZadiak := 3; //Близнецы
If (Month=6) and (Day>=22) or (Month=7) and (Day<=22) then
GetZadiak := 4; //Рак
If (Month=7) and (Day>=23) or (Month=8) and (Day<=23) then
GetZadiak := 5; //Лев
If (Month=8) and (Day>=24) or (Month=9) and (Day<=23) then
GetZadiak := 6; //Дева
If (Month=9) and (Day>=24) or (Month=10) and (Day<=23) then
GetZadiak := 7; //Весы
If (Month=10) and (Day>=24) or (Month=11) and (Day<=22) then
GetZadiak := 8; //Скорпион
If (Month=11) and (Day>=23) or (Month=12) and (Day<=21) then
GetZadiak := 9; //Стрелец
If (Month=12) and (Day>=22) or (Month=1) and (Day<=20) then
GetZadiak := 10; //Козерог
If (Month=1) and (Day>=21) or (Month=2) and (Day<=18) then
GetZadiak := 11; //Водолей
If (Month=2) and (Day>=19) or (Month=3) and (Day<=20) then
GetZadiak := 12; //Рыбы
Except
GetZadiak := 0;
end;
end;
////////////////////////////////////////////////////////////////////////////////
//
// ФУНКЦИЯ: TimeBeforeDate
//
// НАЗНАЧЕНИЕ: Как результат выдает количество оставшихся дней, часов, минут,
// секунд до указанной даты.
//
// ПАРАМЕТРЫ:
// DateX - Дата количество дней до которой необходимо расчитать
// ResType - Тип возвращаемого результата (Дней, Часов, Минут, Секунд)
//
Function TimeBeforeDate(DateX: TDateTime; ResType: Byte): Integer;
Var
DaysX: Integer;
HourX: Integer;
MinutX: Integer;
SecondX: Integer;
begin
DaysX := DaysBetween(Now,VarToDateTime(DateX));
HourX := HoursBetween(Now,VarToDateTime(DateX));
HourX := HourX - (DaysX * 24);
MinutX := MinutesBetween(Now,VarToDateTime(DateX));
MinutX := MinutX - (HoursBetween(Now,VarToDateTime(DateX)) * 60) + 1;
SecondX := SecondsBetween(Now,VarToDateTime(DateX));
SecondX := SecondX - (MinutesBetween(Now,VarToDateTime(DateX)) * 60) + 1;
case ResType of
tbdTypeDay: Result := DaysX;
tbdTypeHour: Result := HourX;
tbdTypeMinute: Result := MinutX;
tbdTypeSecond: Result := SecondX;
end;
end;
end.
Первая процедура определяющая информацию о дате была именно GetDateInfo. С неё все начиналось. Именно она много раз переписывалась и долго отлаживалась на заре моих первых опытов программинга. В данный момент она совершенно рабочая, но тем не менее если кто-то заменит не рациональности или "баги" очень надеюсь что вы сообщите мне об этом. Так же буду рад увидеть более оптимальное решение задач которые решаются данной процедурой.
Функции: GetAgeOf, GetDaysCountOf, GetJubiOf были добавлены уже позднее в данном модуле, специально для уменьшения количества лишнего и повторяющегося кода в приложениях.
Ну и как понятно из комментариев в коде и названий функций,
GetAgeOf - возвращает возраст человека, чей день рождения в формате TDateTime, будет передан в функцию в качестве параметра.
GetDaysCountOf - в качестве результата выдает количество дней оставшихся до дня рождения. Дата рождения так же передается в качестве параметра.
GetJubiOf - может сказать, будет в этом году просто День Рождения либо будет Юбилей. Если Юбилей значит возвращаемое значение равно 1, в противном случае 0.
Далее в модуле можно увидеть функцию возвращающую знак зодиака. Ничего хитрого в ней нет. А написал я её и воспользовался ею так как являюсь старым "вентилятором" интернет-пейджера ICQ. И глядя на Аську я решил в своей той программке реализовать похожую фичу, определять по дате и выводить на экран знак зодиака человека, который записан в базе.
Ну и наконец последняя функция, идея не нова. Множество сайтов видел на которых шёл отсчет времени то до запуска БАКа (Большого Адронного Коллайдера), то до конца света... Ну, а мне как-то раз захотелось подсчитать сколько времени у меня осталось до поездки в город Костанай. Так и написал функцию TimeBeforeDate, которая возвращает, сколько дней, часов, минут и секунд осталось до указанной даты. Работает тоже довольно просто. У кого есть не растраченный энтузиазм, может немного дописать функцию что бы она подсчитывала так же и недели, месяцы, годы, веки =)
Повторюсь, если кто-то найдет в этих функциях "косяк"/"баг", либо захочет оптимизировать работу, либо более подробно распросить как это все работает, пишите, буду рад диалогу.
Теперь прежде чем привести показать небольшой примерчик как это все можно использовать, я покажу код ещё одной функции, которая будет очень полезна для работы с выше описанным модулем. Назначение этой функции состоит в том, что бы грамотно оформить интерфейс, красиво предоставить вычисленную информацию. Итак, код:
////////////////////////////////////////////////////////////////////////////////
//
// ФУНКЦИЯ: NumericalWords
//
// НАЗНАЧЕНИЕ: В зависимости от числа возвращает слово в правильном падеже.
//
// ПАРАМЕТРЫ:
// Word1 - Слово в Именительном падеже.
// Word2 - Слово в Родительном падеже.
// Word3 - Слово во множественом числе и Именительном падеже.
// Num - Число по которому будет определен правильный падеж и число.
//
Function NumericalWords(Word1,Word2,Word3:String;Num:integer): String;
Var
NumStr: String[32];
LenStr,TestNum: Integer;
begin
case Num of
1: NumericalWords := Word1;
2..4: NumericalWords := Word2;
5..20,0: NumericalWords := Word3;
else
begin
NumStr := IntToStr(Num);
LenStr := Length(NumStr);
if LenStr > 1 then
Try
TestNum := StrToInt(NumStr[LenStr-1]);
Except
End;
if TestNum > 1 then
Try
Delete(NumStr,1,LenStr-1);
Except
End
else
Try
Delete(NumStr,1,LenStr-2);
Except
End;
Num := StrToInt(NumStr);
case Num of
1: NumericalWords := Word1;
2..4: NumericalWords := Word2;
5..20,0: NumericalWords := Word3;
end;
end;
end;
end;
Всем известно что некрасиво будет написать "4 день" или "1 дней". То есть чисто с технической точки зрения это понятная форма представления информации. Но всегда и во всем должна присутствовать красота, рациональность. И вот как раз для того что бы выводимые пользователю строки не выводились как в выше описанных примерах, можно воспользоваться функцией NumericalWords. Думаю если погуглить в интернете найдется множество вариантов написания такой функции, но я предлагаю свой, возможно и не самый рациональный метод решения задачи.
А теперь на засыпку приведу пример, как это все можно использовать. Допустим у Вас есть таблица с данными. В таблице забиты фамилии, даты рождения. А помимо этого нужно расчитать сколько лет, юбилей ни юбилей и сколько дней до Дня Рождения осталось. В таком случае у нужного TDataSet создадим 3 вычисляемых поля. А в событии OnCalcFields напишем примерно следующий код:
procedure TdmMainData.dstSubjectCalcFields(DataSet: TDataSet);
Var
Age: Integer;
DaysCount: Integer;
SignI: Integer;
Juby: Integer;
SingnStrM: array [0..12] of String;
begin
SingnStrM[0] := '';
SingnStrM[1] := 'Овен';
SingnStrM[2] := 'Телец';
SingnStrM[3] := 'Близнецы';
SingnStrM[4] := 'Рак';
SingnStrM[5] := 'Лев';
SingnStrM[6] := 'Дева';
SingnStrM[7] := 'Весы';
SingnStrM[8] := 'Скорпион';
SingnStrM[9] := 'Стрелец';
SingnStrM[10] := 'Козерог';
SingnStrM[11] := 'Водолей';
SingnStrM[12] := 'Рыбы';
if dstSubjectDate1.Value <> 0 then
begin
Age := GetAgeOf(dstSubjectDate1.Value);
DaysCount := GetDaysCountOf(dstSubjectDate1.Value);
SignI := GetZadiak(dstSubjectDate1.Value);
dstSubjectclAge.Value := IntToStr(Age) + NumericalWords(' год',' года',' лет',Age);
dstSubjectclBeforeHB.Value := IntToStr(DaysCount) + NumericalWords(' день',' дня',' дней',DaysCount);
dstSubjectclSign.Value := SingnStrM[SignI];
end
else
begin
dstSubjectclAge.Value := '';
dstSubjectclBeforeHB.Value := '';
dstSubjectclSign.Value := '';
end;
Juby := GetJubiOf(dstSubjectDate1.Value);
// Отобразим иконки в гриде. Соответсвенно юбилею, просто ДР или ничего..
If (DaysCount <= 3) and (Juby = 0) then
dstSubjectclIcon.Value := 1
else if (DaysCount <= 3) and (Juby = 1) then
dstSubjectclIcon.Value := 2
else
dstSubjectclIcon.Value := 0;
end;
В данном примере так же показано что помимо прочего в гриде можно добавить колонку в которой в зависимости от близости празднества будет отображаться соответствующая иконка. Например красный надувной шарик, как в той же Аське.
По хорошему, конечно, то что описано выше - делать НЕЛЬЗЯ! Почему спросите Вы? Да потому что, вам может быть и не понадобиться все выведенные данные. А если в базе записей более тысячи? Компьютеру придется попыхтеть. Пользователь конечно можно быть и не заметит колоссальной работы машины. Особенно учитывая современные мощности. Тем не менее подход является не оптимальным, и в идеале такого рода задачу нужно переносить на СУБД. Что в принципе я думаю реально. И намериваюсь заняться этой задачей в свободное время. Ну а пока, рекомендую выше изложенный материал использовать более гуманно по отношению к вашему ЦП. Например, под Гридом с данными можно "нарисовать" поля, и при переходе на новую запись в базе, проводить подсчеты и выводить данные в эти поля (лэйблы). В результате у Вас должно получиться что-то вроде этого:
Но это лишь один вариант, а их очень много, так что включаем фантазию и творим.
Думаю это пока все. В завершение с позволения сказать статьи, скажу так: пишите код, оптимизируйте, найдя баги печатайте его и скомкав лист бумаги бросайте его в камин.
Не все то оптимально, что складно написано, не все то рационально что легко получается. Все гениальное - просто...
В общем если у вас есть интересные мысли, замечания или идеи на данную тему, пишите, буду рад.
