Содержание материала

 

Code:

{ **** UBPFD *********** by delphibase.endimus ****

>> Конвертация денежных сумм в строковое выражение

 

Конвертация денежных сумм в строковое выражение впоть до додециллиона,

причем легко наращивается. Небольшая по размеру.

 

Зависимости: System

Автор: Раков Андрей, klopmail mail.ru, Курчатов

Copyright: Раков А.В.

Дата: 17 августа 20012 г.

***************************************************** }

 

function MoneyToStr(DD: string): string;

{(С) Раков А.В. 05.2002 e-mail: klopmail mail.ru сайт: }

type

TTroyka = array[1..3] of Byte;

TMyString = array[1..19] ofstring[12];

var

S, OutS, S2: string;

k, L, kk: Integer;

Troyka: TTroyka;

V1: TMyString;

Mb: Byte;

const

V11: TMyString =

('один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять',

'десять', 'одиннадцать',

'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать', 'шестнадцать',

'семнадцать', 'восемнадцать', 'девятнадцать');

V2: array[1..8] ofstring =

('двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят', 'семьдесят',

'восемьдесят', 'девяносто');

V3: array[1..9] ofstring =

('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот',

'восемьсот', 'девятьсот');

M1: array[1..13, 1..3] ofstring = (('тысяча', 'тысячи', 'тысяч'),

('миллион', 'миллиона', 'миллионов'),

('миллиард', 'миллиарда', 'миллиардов'),

('триллион', 'триллиона', 'триллионов'),

('квадриллион', 'квадриллиона', 'квадриллионов'),

('квинтиллион', 'квинтиллиона', 'квинтиллионов'),

('секстиллион', 'секстиллиона', 'секстиллионов'),

('сентиллион', 'сентиллиона', 'сентиллионов'),

('октиллион', 'октиллиона', 'октиллионов'),

('нониллион', 'нониллиона', 'нониллионов'),

('дециллион', 'дециллиона', 'дециллионов'),

('ундециллион', 'ундециллиона', 'ундециллионов'),

('додециллион', 'додециллиона', 'додециллионов'));

R1: array[1..3] ofstring = ('рубль', 'рубля', 'рублей');

R2: array[1..3] ofstring = ('копейка', 'копейки', 'копеек');

function TroykaToStr(L: ShortInt; TR: TTroyka): string;

var

S: string;

begin

S := '';

if Abs(L) = 1then

begin

V1[1] := 'одна';

V1[2] := 'две';

end

else

begin

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

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

end;

if Troyka[2] = 1then

begin

Troyka[2] := 0;

Troyka[3] := 10 + Troyka[3];

end;

if Troyka[3] <> 0then

S := V1[Troyka[3]];

if Troyka[2] <> 0then

S := V2[Troyka[2] - 1] + ' ' + S;

if Troyka[1] <> 0then

S := V3[Troyka[1]] + ' ' + S;

if (L > 0) and (S <> '') then

case Troyka[3] of

1: S := S + ' ' + M1[L, 1] + ' ';

2..4: S := S + ' ' + M1[L, 2] + ' ';

else

S := S + ' ' + M1[L, 3] + ' ';

end;

TroykaToStr := S;

end;

begin

V1 := V11;

L := 0;

OutS := '';

kk := Pos(',', DD);

if kk = 0then

S := DD

else

S := Copy(DD, 1, kk - 1);

if S = '0'then

S2 := ''

else

S2 := S;

repeat

for k := 3downto1do

if Length(S) > 0then

begin

Troyka[k] := StrToInt(S[Length(S)]);

Delete(S, Length(S), 1);

end

else

Troyka[k] := 0;

OutS := TroykaToStr(L, Troyka) + OutS;

if L = 0then

Mb := Troyka[3];

Inc(L);

until Length(S) = 0;

case Mb of

0: if Length(S2) > 0then

OutS := OutS + ' ' + R1[3] + ' ';

1: OutS := OutS + ' ' + R1[1] + ' ';

2..4: OutS := OutS + ' ' + R1[2] + ' ';

else

OutS := OutS + ' ' + R1[3] + ' ';

end;

S2 := '';

if kk <> 0then

begin

DD := Copy(DD, kk + 1, 2);

if Length(DD) = 1then

DD := DD + '0';

k := StrToInt(DD);

Troyka[1] := 0;

Troyka[2] := k div10;

Troyka[3] := k mod10;

S2 := TroykaToStr(-1, Troyka);

case Troyka[3] of

0: if Troyka[2] = 0then

S := ''

else

S := R2[3];

1: S := R2[1];

2..4: S := R2[2];

else

S := R2[3];

end;

end;

// MoneyToStr:=OutS+IntToStr(k)+' '+S; // если копейки нужны цифрой-эту строку раскоментировать

MoneyToStr := OutS + S2 + ' ' + S; // а эту закоментировать

end;

Пример использования:

 

S := MoneyToStr('76576876876976576437654365,98');

 

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить