MoneyToTextEx

Описание настроек MoneyToTextEx
 
Настройка предназначена для вывода числительных прописью в печатных формах на определённом языке.

Название – краткое название функции.
Наименование – полное название функции.
Синтаксис функции — параметры вызова функции.
Описание – краткое описание функции.
Язык – язык локализации, для которого будет работать функция, т.е. на каком языке запущено и используется само ПО.
Исходный код – текст скрипта.
Текущая версия – номер текущей версии.
 
Внимание! Описанный далее код функции является примером реализации для русского языка. Для других языков он может быть изменён в соответствии с особенностями самого языка
(например, отсутствие падежей, родов числительных в английском языке).

Вспомогательная функция округления с заданной точностью

function RoundDouble(AValue: Double; FracLen: Integer): Double;

var

 D10: array[0..10] of Double;

begin

 D10[0]  := 1;

 D10[1]  := 10;

 D10[2]  := 100;

 D10[3]  := 1000;

 D10[4]  := 10000;

 D10[5]  := 100000;

 D10[6]  := 1000000;

 D10[7]  := 10000000;

 D10[8]  := 100000000;

 D10[9]  := 1000000000;

 D10[10] := 10000000000.0;

 Result := (Round(AValue * D10[FracLen] + 1 / D10[FracLen + 1])) / D10[FracLen];

end;

Вспомогательная функция округления до второго знака после запятой

function RoundMoney(ASum: Double): Double;

begin

 Result := RoundDouble(ASum, 2)

end;

Вспомогательная функция копирования части строки

function RightStr(S: string; N: Integer): string;

begin

 if (N <= 0) then

   N := Length(S) + N;

 Result := Copy(S, Length(S) - N + 1, N);

end;

Вспомогательная функция копирования части строки и подстановки заданного символа слева

function PadLCh(S: string; C: Char; N: Byte; ExactLen: Boolean = True): string;

begin

 if ExactLen then

   Result := RightStr(S,N)

 else

   Result := S;

 while Length(Result) < N do

   Result := C + Result;

end;

Основная функция преобразования денежной суммы в сумму прописью

Входные параметры:

Sum — число для преобразования

Param_Language — язык локализации

Currency — код валюты

function MoneyToTextEx (Sum: Double; Param_Language: string; Currency: string): string;

var

 aOnes, aTeens, aTens, aHundreds, aTrios, aTrioFemale, aTrioPostfixes, aUnits,

   aUnitPostfixes, aUnitFemale, aPostfixes, aPostfix: Variant;

КЛАССЫ ЧИСЕЛ

Первый класс (класс единиц) – сотни, десятки, единицы

Второй класс (класс тысяч) – сотни тысяч, десятки тысяч, единицы тысяч

Третий класс (класс миллионов) – сотни миллионов, десятки миллионов, единицы миллионов

… и т.д.

Функция преобразования трехзначного числа в строку с добавлением класса чисел или значения валюты

 function TrioToText(Trio: Integer; TrioNo: Integer): string;

 var

   i1, i2, i3, PostfixNo: Integer;

   Female: Boolean;

 begin

   Result := '';

   if( Trio = 0) then

     if TrioNo > 0 then Exit; - если число [0] и «не копейки», то выходим из функции («ноль миллионов», «ноль тысяч» не пишем)

   i1 := (Trio mod 10); - выделяем единицы

   i2 := (Trio div 10) mod 10; - выделяем десятки

   i3 := (Trio div 100) mod 10; - выделяем сотни

   if (TrioNo > -1) then - если «не копейки»

   begin

     Result := aHundreds[i3]; - берем сотню из массива сотен

     if (i2 = 1) then – если второй десяток сотни (десять, одиннадцать...)

        Result := Trim(Result + ' ' + aTeens[i1]) - то берем из массива второго десятка по значению единиц

     else - если не второй десяток сотни (т.е. двадцать..., тридцать...,..)

     begin

       Result := Trim(Result + ' ' + aTens[i2]); - берем из массива десятков по значению десятка

       if (i1 in [1, 2]) then – если единица 1 или 2 (в русском языке «один» и «два» для женского рода это - «одна» и «две», остальные единицы идентичны для М и Ж: «три», «четыре»... «десять»)

       begin

         if (TrioNo > 0) then - если класс числа более первого (тысячи, миллионы, миллиарды и т.д.)

           Female := aTrioFemale[TrioNo] - берем признак женского рода в заданном массиве женских родов для классов чисел более первого (тысячи, миллионы, миллиарды и т.д.), т.е. если сюда пришел второй класс, в русском языке «тысяча» женского рода.

         else

           Female := aUnitFemale[1 – TrioNo] - если первый класс или «копейки», смотрим значение женского рода в массиве женских родов, заданном для конкретной валюты (рубль мужского рода, копейка женского рода; доллар мужского рода, цент мужского рода)

       end

       else

         Female := False; - если единица не 1 или 2, то мужской род («три», «четыре»...)

       if not Female then

         Result := Trim(Result + ' ' +  aOnes[i1]) - если мужской род, то берем единицу из массива единиц напрямую (индекс совпадает со значением)

       else

         Result := Trim(Result + ' ' + aOnes[9 + i1]); - если женский род, то берем единицу из массива единиц с инкрементом (для русского языка это будет 1 или 2, соответственно 9+1 = 10, в массиве единиц с индексом 10 идет женский род «одна»)

     end;

   end

   else - если «копейки»

     Result := PadLCh(IntToStr(Trio), '0', 2); - если «копейки», то сумму прописью не пишем, а к однозначному числу добавляем ноль слева (было 5, стало 05; было 55, стало 55)

После выполнения вышеуказанной части кода процедуры мы получаем одно-, двух- или трехзначное число прописью (451 = «четыреста пятьдесят один» для мужского рода класса чисел или «четыреста пятьдесят одна» для женского рода класса чисел).

   if (TrioNo > 0) then - если класс числа более первого (тысячи, миллионы, миллиарды и тд)

     Result := Trim(Result + ' ' + aTrios[TrioNo]) - берем значение из массива классов чисел напрямую

   else

     Result := Trim(Result + ' ' + aUnits[1 – TrioNo]); - если класс менее первого, то берем значение из массива валюты («рубл», «копе»)

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

   PostfixNo := 1; - по умолчанию берём индекс массива окончаний 1 (тысячА/копеЙКА/рублЬ/миллион)

   if (Param_Language = 'Russian') then

   begin

     PostfixNo := 3; - если язык русский по умолчанию, берём индекс массива окончаний 3 (рублЕЙ/копеЕК/миллионОВ/тысяч)

     if not (i2 = 1) then - если не второй десяток сотни, то определяем индекс массива окончаний

     begin - смотрим на единицы

       if (i1 = 1) then - если единица равна 1

         PostfixNo := 1 - берем индекс массива окончаний 1 (тысячА/копеЙКА/рублЬ/миллион)

       else

       if (i1 in [2, 3, 4]) then - если единица равна 2 или 3 или 4

         PostfixNo := 2; - берём индекс массива окончаний 2 (тысячИ/копеЙКИ/рублЯ/миллионА)

     end;

   end

   else

Для других языков

   if (Param_Language = 'Lithuanian') then

   begin

     PostfixNo := 3;

     if not (i2 = 1) then

     begin

       if (i1 = 1) then

         PostfixNo := 1

       else

       if (i1 in [2..9]) then

         PostfixNo := 2;

     end;

   end;

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

   if (TrioNo > 0) then - для классов чисел

   begin

     aPostfix := aPostfixes[aTrioPostfixes[TrioNo]]; - определяем массив окончаний соответствующего класса чисел

     Result := Result + aPostfix[PostfixNo]; - добавляем окончание по определенному ранее индексу из соответствующего массива

   end

   else - для валют

   begin

     aPostfix := aPostfixes[aUnitPostfixes[1 – TrioNo]]; - определяем массив окончаний соответствующего значения валюты («рубл»/«копе»)

     Result := Result + aPostfix[PostfixNo];- добавляем окончание по определенному ранее индексу из соответствующего массива

   end;

 end;

Тело основной функции преобразования денежной суммы в сумму прописью

var

 I: Int64;

 F: Integer;

begin

 Result := '';

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

Массив первого десятка сотни (единиц)

 aOnes := VarArrayCreate([0,11], varVariant);

 aOnes[0]  := '';

 aOnes[1]  := 'один';

 aOnes[2]  := 'два';

 aOnes[3]  := 'три';

 aOnes[4]  := 'четыре';

 aOnes[5]  := 'пять';

 aOnes[6]  := 'шесть';

 aOnes[7]  := 'семь';

 aOnes[8]  := 'восемь';

 aOnes[9]  := 'девять';

 aOnes[10] := 'одна';

 aOnes[11] := 'две';

Массив второго десятка сотни:

 aTeens := VarArrayCreate([0,9], varVariant);

 aTeens[0] := 'десять';

 aTeens[1] := 'одиннадцать';

 aTeens[2] := 'двенадцать';

 aTeens[3] := 'тринадцать';

 aTeens[4] := 'четырнадцать';

 aTeens[5] := 'пятнадцать';

 aTeens[6] := 'шестнадцать';

 aTeens[7] := 'семнадцать';

 aTeens[8] := 'восемнадцать';

 aTeens[9] := 'девятнадцать';

Массив десятков:

 aTens := VarArrayCreate([0,9], varVariant);

 aTens[0] := '';

 aTens[1] := 'десять';

 aTens[2] := 'двадцать';

 aTens[3] := 'тридцать';

 aTens[4] := 'сорок';

 aTens[5] := 'пятьдесят';

 aTens[6] := 'шестьдесят';

 aTens[7] := 'семьдесят';

 aTens[8] := 'восемьдесят';

 aTens[9] := 'девяносто';

Массив сотен:

 aHundreds := VarArrayCreate([0,9], varVariant);

 aHundreds[0] := '';

 aHundreds[1] := 'сто';

 aHundreds[2] := 'двести';

 aHundreds[3] := 'триста';

 aHundreds[4] := 'четыреста';

 aHundreds[5] := 'пятьсот';

 aHundreds[6] := 'шестьсот';

 aHundreds[7] := 'семьсот';

 aHundreds[8] := 'восемьсот';

 aHundreds[9] := 'девятьсот';

Массив классов чисел:

 aTrios := VarArrayCreate([0,4], varVariant);

 aTrios[0] := '';

 aTrios[1] := 'тысяч';

 aTrios[2] := 'миллион';

 aTrios[3] := 'миллиард';

 aTrios[4] := 'триллион';

Массив признаков женского рода для классов чисел:

 aTrioFemale := VarArrayCreate([1,4], varVariant);

 aTrioFemale[1] := True;

 aTrioFemale[2] := False;

 aTrioFemale[3] := False;

 aTrioFemale[4] := False;

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

 aPostfixes := VarArrayCreate([1,8], varVariant);

 aPostfix := VarArrayCreate([1,3], varVariant);

 aPostfix[1] := 'а';

 aPostfix[2] := 'и';

 aPostfix[3] := '';

 aPostfixes[1] := aPostfix;

 aPostfix := VarArrayCreate([1,3], varVariant);

 aPostfix[1] := '';

 aPostfix[2] := 'а';

 aPostfix[3] := 'ов';

 aPostfixes[2] := aPostfix;

 aPostfix := VarArrayCreate([1,3], varVariant);

 aPostfix[1] := 'ь';

 aPostfix[2] := 'я';

 aPostfix[3] := 'ей';

 aPostfixes[3] := aPostfix;

 aPostfix := VarArrayCreate([1,3], varVariant);

 aPostfix[1] := 'йка';

 aPostfix[2] := 'йки';

 aPostfix[3] := 'ек';

 aPostfixes[4] := aPostfix;

 aPostfix := VarArrayCreate([1,3], varVariant);

 aPostfix[1] := 'ка';

 aPostfix[2] := 'ка';

 aPostfix[3] := 'ок';

 aPostfixes[5] := aPostfix;

 aPostfix := VarArrayCreate([1,3], varVariant);

 aPostfix[1] := '';

 aPostfix[2] := '';

 aPostfix[3] := '';

 aPostfixes[6] := aPostfix;

Массив соответствий классов чисел и их окончаний

 aTrioPostfixes := VarArrayCreate([1,4], varVariant);

 aTrioPostfixes[1] := 1; - для «тысяч» массив из массива массивов aPostfixes с индексом 1 ( ['а','и',''])

 aTrioPostfixes[2] := 2; - для «миллион» массив из массива массивов aPostfixes с индексом 2 ['','а','ов']

 aTrioPostfixes[3] := 2; - для «миллард» массив из массива массивов aPostfixes с индексом 2 ['','а','ов']

 aTrioPostfixes[4] := 2; - для «триллион» массив из массива массивов aPostfixes с индексом 2 ['','а','ов']

 aUnits := VarArrayCreate([1,2], varVariant); - массив корней значений валют (рубл, копе)

 aUnitPostfixes := VarArrayCreate([1,2], varVariant); - массив соответствий корней значений валют и их окончаний

 aUnitFemale := VarArrayCreate([1,2], varVariant); - массив признаков женского рода значений валют (рубль мужского рода, копейка женского рода; доллар мужского рода, цент мужского рода)

Заполняем массивы для необходимых типов валют.

 if (Currency = 'USD')  or (Currency = '') then

 begin

   aUnits[1] := 'доллар';

   aUnits[2] := 'цент';

   aUnitPostfixes[1] := 2;

   aUnitPostfixes[2] := 2;

   aUnitFemale[1] := False;

   aUnitFemale[2] := False;

 end

 else        

 if (Currency = 'RUB') or (Currency = 'RUR')   then

 begin

   aUnits[1] := 'рубл';

   aUnits[2] := 'копе';

   aUnitPostfixes[1] := 3;

   aUnitPostfixes[2] := 4;

   aUnitFemale[1] := False;

   aUnitFemale[2] := True;

   end

 else        

 if Currency = 'KGS' then

 begin

   aUnits[1] := 'сом';

   aUnits[2] := 'тыйын';

   aUnitPostfixes[1] := 6;

   aUnitPostfixes[2] := 6;

   aUnitFemale[1] := False;

   aUnitFemale[2] := False;

 end

 else        

 if Currency = 'KZT' then

 begin

   aUnits[1] := 'тенге';

   aUnits[2] := 'тиын';

   aUnitPostfixes[1] := 6;

   aUnitPostfixes[2] := 6;

   aUnitFemale[1] := False;

   aUnitFemale[2] := False;

 end

 else        

 if Currency = 'EUR' then

 begin

   aUnits[1] := 'евро';

   aUnits[2] := 'цент';

   aUnitPostfixes[1] := 6;

   aUnitPostfixes[2] := 2;

   aUnitFemale[1] := False;

   aUnitFemale[2] := False;

 end;

 Sum := RoundMoney(Abs(Sum)); - округляем исходное число

 I := Trunc(Sum); - выделяем целую часть(рубли, доллары...)

 F := Round(Sum * 100) mod 100; - выделяем дробную часть (копейки, центы...)

 Result := Trim(Result + ' ' + TrioToText((I div 1000000000) mod 1000, 3)); - выделяем и преобразовываем в пропись миллиарды

 Result := Trim(Result + ' ' + TrioToText((I div 1000000) mod 1000, 2));- выделяем и преобразовываем в пропись миллионы

 Result := Trim(Result + ' ' + TrioToText((I div 1000) mod 1000, 1));- выделяем и преобразовываем в пропись тысячи

 Result := Trim(Result + ' ' + TrioToText(I mod 1000, 0));- выделяем и преобразовываем в пропись сотни

 Result := Trim(Result + ' ' + TrioToText(F , -1)); - преобразовываем в пропись дробную часть

 Result[1] := UpperCase(Result[1])[1]; - результат пишем с большой буквы

end;

begin

end
 
После перевода результат можно проверить через кнопку .

Sum – число для преобразования.

Param_Language – язык локализации.
Currency – код валюты.

 
Пример 1

Программа используется на русском языке, но числительные прописью должны отображаться на другом языке (вместо «рубль» и «копейка», например, «тугрик» и «тугрятик»).

else        

 if Currency = 'TUG' then

 begin

   aUnits[1] := 'тугрик';

   aUnits[2] := 'тугрятик';

   aUnitPostfixes[1] := 7;

   aUnitPostfixes[2] := 7;

   aUnitFemale[1] := False;

   aUnitFemale[2] := False;

 end

aPostfix := VarArrayCreate([1,3], varVariant);

 aPostfix[1] := '';

 aPostfix[2] := 'а';

 aPostfix[3] := 'ов';

 aPostfixes[7] := aPostfix;

*Если массив с такими значениями уже присутствует (например, массив 2 имеет те же окончания, что мы создали в массиве 7), то можно новый не создавать, а установить:

aUnitPostfixes[1] := 2;

aUnitPostfixes[2] := 2;

aPostfixes := VarArrayCreate([1,7], varVariant);

[Сохранить] -> Получить результат.