Автор: LexusR
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> преобразование даты типа TDateTime в дату прописью

преобразование даты типа TDateTime в дату прописью
типа : "четырнадцатое ноября две тысячи третьего года"

Зависимости: Windows,SysUtils
Автор:       LexusR, ICQ:41627622, Novosibirsk
Copyright:   LexusR
Дата:        12 декабря 2003 г.
***************************************************** }

const
  MonthNames: array[1..12] of string = ('января', 'февраля', 'марта', 'апреля',
    'мая', 'июня', 'июля', 'августа', 'сентября', 'октября', 'ноября',
      'декабря');
  NamesOfThousand0: array[1..2] of string = ('тысячного', 'двухтысячного');
  NamesOfThousand: array[1..2] of string = ('одна тысяча', 'две тысячи');
  NamesOfHandreds0: array[1..9] of string = ('сотого', 'двухсотого',
    'трехсотого',
    'четырехсотого', 'пятисотого', 'шестисотого', 'семисотого',
    'восьмисотого', 'девятисотого');
  NamesOfHandreds: array[1..9] of string('сто', 'двести', 'триста', 'четыреста',
    'пятьсот', 'шестьсот', 'семьсот', 'восемьсот', 'девятьсот');
  NamesOfTens00: array[1..3] of string('десятое', 'двадцатое', 'тридцатое');
  NamesOfTens0: array[1..9] of string('десятого', 'двадцатого',
    'тридцатого', 'сорокового', 'пятидесятого', 'шестидесятого',
    'семидесятого', 'восьмидесятого', 'девяностого');
  NamesOfTens: array[2..9] of string = ('двадцать', 'тридцать', 'сорок',
    'пятьдесят', 'шестьдесят', 'семьдесят', 'восемьдесят', 'девяносто');
  NamesOfFistTen0: array[1..9] of string = ('одинадцатое', 'двенадцатое',
    'тринадцатое', 'четырнадцатое', 'пятнадцатое', 'шестнадцатое',
      'семнадцатое',
    'восемьнадцатое', 'девятнадцатое');
  NamesOfFistTen: array[1..9] of string = ('одинадцатого', 'двенадцатого',
    'тринадцатого', 'четырнадцатого', 'пятнадцатого', 'шестнадцатого',
    'семнадцатого', 'восемьнадцатого', 'девятнадцатого');
  NamesOfUnits0: array[1..9] of string = ('первое', 'второе', 'третье',
    'четвертое', 'пятое', 'шестое', 'седьмое', 'восьмое', 'девятое');
  NamesOfUnits: array[1..9] of string = ('первого', 'второго', 'третьего',
    'четвертого', 'пятого', 'шестого', 'седьмого', 'восьмого', 'девятого');

function ConvertDateToString(Date: TDateTime): string;
var
  year, month, day: word;
  th, hn, tn, un: word;
begin
  DecodeDate(Date, year, month, day);
  // разбираем число
  tn := day div 10;
  un := day mod 10;
  if un = 0 then
    result := NamesOfTens00[tn]
  else if tn = 0 then
    result := NamesOfUnits0[un]
  else if tn = 1 then
    result := NamesOfFistTen0[un]
  else
    result := NamesOfTens[tn] + ' ' + NamesOfUnits0[un];
  // разбираем месяц
  result := result + ' ' + MonthNames[month];
  // разбираем год
  th := year div 1000;
  hn := year mod 1000 div 100;
  tn := year mod 1000 mod 100 div 10;
  un := year mod 1000 mod 100 mod 10;
  if ((hn = 0) and (tn = 0) and (un = 0)) then
  begin
    result := result + ' ' + NamesOfThousand0[th] + ' года';
    exit;
  end
  else
    result := result + ' ' + NamesOfThousand[th];
  if hn > 0 then
  begin
    if ((tn = 0) and (un = 0)) then
    begin
      result := result + ' ' + NamesOfHandreds0[hn] + ' года';
      exit;
    end
    else
      result := result + ' ' + NamesOfHandreds[hn];
  end;
  if un = 0 then
    result := result + ' ' + NamesOfTens0[tn]
  else if tn = 0 then
    result := result + ' ' + NamesOfUnits[un]
  else if tn = 1 then
    result := result + ' ' + NamesOfFistTen[un]
  else
    result := result + ' ' + NamesOfTens[tn] + ' ' + NamesOfUnits[un];
  result := result + ' года'
end;