Внешние функции - 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

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

Shelter v.2 \ Настройки \ Справочники \ Услуги и оплаты \ Валюты: заменить Рубли на Тугрики.

*В коде важен регистр букв!

Shelter v.2 \ Настройки \ Настройки отчётов \ Внешние функции: открыть внешнюю функцию для программы на русском языке (по умолчанию это - №1).

Внести изменения в исходный код:

Найти раздел, например, KZT. Скопировать данные из него и вставить следующим разделом ниже.

Внести изменения: KZT -> TUG, тенге -> тугрик, тиын -> тугрятик, массив для окончаний указать 7 для обоих aUnits (базово всего 6, т.е. нужно будет добавить новый).

 

else

 

if Currency = 'TUG' then

 

begin

 

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

 

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

 

aUnitPostfixes[1] := 7;

 

aUnitPostfixes[2] := 7;

 

aUnitFemale[1] := False;

 

aUnitFemale[2] := False;

 

end

 

В разделе массивов окончаний создать новый (в нашем примере - 7) и внести изменения по окончаниям и номеру массива.

 

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

 

aPostfix[1] := '';

 

aPostfix[2] := 'а';

 

aPostfix[3] := 'ов';

 

aPostfixes[7] := aPostfix;

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

aUnitPostfixes[1] := 2;

aUnitPostfixes[2] := 2;

Найти запись массива массивов окончаний и установить максимально 7, вместо 6.

 

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

 

Произвести проверку результата изменений через кнопку [Проверить]:

Sum – числительное с десятыми или сотыми (разделитель – точка!).

Param_LanguageRussian (язык программы, для которого настроена валюта).

CurrencyTUG (валюта, в которой нужно числительное изобразить прописью).

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