Числа прописью -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [3.138.125.2]

Модераторы: Rouse_, jack128, Krid

Числа прописью

Song

Сообщ. #1 , 13.12.03, 06:14

Unregistered

Вот несколько решений.

Автор Александр

{------------------------ Деньги прописью ---------------------}

function TextSum(S: double): string;

function Conv999(M: longint; fm: integer): string;

const

c1to9m: array[1..9] of string[6] =

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

c1to9f: array[1..9] of string[6] =

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

c11to19: array[1..9] of string[12] =

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

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

c10to90: array[1..9] of string[11] =

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

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

c100to900: array[1..9] of string[9] =

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

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

var

s: string;

i: longint;

begin

s := '';

i := M div 100;

if i <> 0 then s := c100to900[i] + ' ';

M := M mod 100;

i := M div 10;

if (M > 10) and (M < 20) then

s := s + c11to19[M - 10] + ' '

else

begin

if i <> 0 then s := s + c10to90[i] + ' ';

M := M mod 10;

if M <> 0 then

if fm = 0 then

s := s + c1to9f[M] + ' '

else

s := s + c1to9m[M] + ' ';

end;

Conv999 := s;

end;

{--------------------------------------------------------------}

var

i: longint;

j: longint;

r: real;

t: string;

begin

t := '';

j := Trunc(S / 1000000000.0);

r := j;

r := S - r * 1000000000.0;

i := Trunc(r);

if j <> 0 then

begin

t := t + Conv999(j, 1) + 'миллиард';

j := j mod 100;

if (j > 10) and (j < 20) then

t := t + 'ов '

else

case j mod 10 of

0: t := t + 'ов ';

1: t := t + ' ';

2..4: t := t + 'а ';

5..9: t := t + 'ов ';

end;

j := i div 1000000;

if j <> 0 then

begin

t := t + Conv999(j, 1) + 'миллион';

j := j mod 100;

if (j > 10) and (j < 20) then

t := t + 'ов '

else

case j mod 10 of

0: t := t + 'ов ';

1: t := t + ' ';

2..4: t := t + 'а ';

5..9: t := t + 'ов ';

end;

i := i mod 1000000;

j := i div 1000;

if j <> 0 then

begin

t := t + Conv999(j, 0) + 'тысяч';

j := j mod 100;

if (j > 10) and (j < 20) then

t := t + ' '

else

case j mod 10 of

0: t := t + ' ';

1: t := t + 'а ';

2..4: t := t + 'и ';

5..9: t := t + ' ';

end;

i := i mod 1000;

j := i;

if j <> 0 then t := t + Conv999(j, 1);

t := t + 'руб. ';

i := Round(Frac(S) * 100.0);

t := t + Long2Str(i) + ' коп.';

TextSum := t;

end;

--------------------------------------------------------------------------------

unit RoubleUnit;

{$D Пропись © Близнец Антон '99 http:\\anton-bl.chat.ru\delphi\1001.htm }

{ 1000011.01->'Один миллион одинадцать рублей 01 копейка' }

interface

function RealToRouble(c: Extended): string;

implementation

uses SysUtils, math;

const Max000 = 6; {Кол-во триплетов - 000}

MaxPosition = Max000 * 3; {Кол-во знаков в числе }

//Аналог IIF в Dbase есть в proc.pas для основных типов, частично объявлена тут для независимости

function IIF(i: Boolean; s1, s2: Char): Char; overload; begin if i then

result := s1

else

result := s2 end;

function IIF(i: Boolean; s1, s2: string): string; overload; begin if i then

result := s1

else

result := s2 end;

function NumToStr(s: string): string; {Возвращает число прописью}

const c1000: array[0..Max000] of string = ('', 'тысяч', 'миллион', 'миллиард', 'триллион', 'квадраллион', 'квинтиллион');

c1000w: array[0..Max000] of Boolean = (False, True, False, False, False, False, False);

w: array[False..True, '0'..'9'] of string[3] = (('ов ', ' ', 'а ', 'а ', 'а ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов '),

(' ', 'а ', 'и ', 'и ', 'и ', ' ', ' ', ' ', ' ', ' '));

function Num000toStr(S: string; woman: Boolean): string; {Num000toStr возвращает число для триплета}

const c100: array['0'..'9'] of string = ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ');

c10: array['0'..'9'] of string = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто ');

c11: array['0'..'9'] of string = ('', 'один', 'две', 'три', 'четыр', 'пят', 'шест', 'сем', 'восем', 'девят');

c1: array[False..True, '0'..'9'] of string = (('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '),

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

begin {Num000toStr}

Result := c100[s[1]] + iif((s[2] = '1') and (s[3] > '0'), c11[s[3]] + 'надцать ', c10[s[2]] + c1[woman, s[3]]);

end; {Num000toStr}

var s000: string[3];

isw, isMinus: Boolean;

i: integer; //Счётчик триплетов

begin

Result := ''; i := 0;

isMinus := (s <> '') and (s[1] = '-');

if isMinus then s := Copy(s, 2, Length(s) - 1);

while not ((i >= Ceil(Length(s) / 3)) or (i >= Max000)) do

begin

s000 := Copy('00' + s, Length(s) - i * 3, 3);

isw := c1000w[i];

if (i > 0) and (s000 <> '000') then //тысячи и т.д.

Result := c1000[i] + w[Isw, iif(s000[2] = '1', '0', s000[3])] + Result;

Result := Num000toStr(s000, isw) + Result;

Inc(i)

end;

if Result = '' then Result := 'ноль';

if isMinus then Result := 'минус ' + Result;

end; {NumToStr}

function RealToRouble(c: Extended): string;

const ruble: array['0'..'9'] of string[2] = ('ей', 'ь', 'я', 'я', 'я', 'ей', 'ей', 'ей', 'ей', 'ей');

Kopeek: array['0'..'9'] of string[3] = ('ек', 'йка', 'йки', 'йки', 'йки', 'ек', 'ек', 'ек', 'ек', 'ек');

function ending(const s: string): Char;

var l: Integer; //С l на 8 байт коротче $50->$48->$3F

begin //Возвращает индекс окончания

l := Length(s);

Result := iif((l > 1) and (s[l - 1] = '1'), '0', s[l]);

end;

var rub: string[MaxPosition + 3]; kop: string[2];

begin {Возвращает число прописью с рублями и копейками}

Str(c: MaxPosition + 3: 2, Result);

if Pos('E', Result) = 0 then //Если число можно представить в строке <>1E+99

begin

rub := TrimLeft(Copy(Result, 1, Length(Result) - 3));

kop := Copy(Result, Length(Result) - 1, 2);

Result := NumToStr(rub) + ' рубл' + ruble[ending(rub)]

+ ' ' + kop + ' копе' + Kopeek[ending(kop)];

Result := AnsiUpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1);

end;

end.

--------------------------------------------------------------------------------

Редянов Денис

function CifrToStr(Cifr: string; Pr: Integer; Padeg: Integer): string;

{Функция возвращает прописью 1 цифры признак 3-единицы 2-десятки 1-сотни 4-11-19

Padeg - 1-нормально 2- одна, две }

var i: Integer;

begin

i := StrToInt(Cifr);

if Pr = 1 then

case i of

1: CifrToStr := 'сто';

2: CifrToStr := 'двести';

3: CifrToStr := 'триста';

4: CifrToStr := 'четыреста';

5: CifrToStr := 'пятьсот';

6: CifrToStr := 'шестьсот';

7: CifrToStr := 'семьсот';

8: CifrToStr := 'восемьсот';

9: CifrToStr := 'девятьсот';

0: CifrToStr := '';

end

else if Pr = 2 then

case i of

1: CifrToStr := '';

2: CifrToStr := 'двадцать';

3: CifrToStr := 'тридцать';

4: CifrToStr := 'сорок';

5: CifrToStr := 'пятьдесят';

6: CifrToStr := 'шестьдесят';

7: CifrToStr := 'семьдесят';

8: CifrToStr := 'восемьдесят';

9: CifrToStr := 'девяносто';

0: CifrToStr := '';

end

else if Pr = 3 then

case i of

1: if Padeg = 1 then

CifrToStr := 'один'

else

CifrToStr := 'одна';

2: if Padeg = 1 then

CifrToStr := 'два'

else

CifrToStr := 'две';

3: CifrToStr := 'три';

4: CifrToStr := 'четыре';

5: CifrToStr := 'пять';

6: CifrToStr := 'шесть';

7: CifrToStr := 'семь';

8: CifrToStr := 'восемь';

9: CifrToStr := 'девять';

0: CifrToStr := '';

end

else if Pr = 4 then

case i of

1: CifrToStr := 'одиннадцать';

2: CifrToStr := 'двенадцать';

3: CifrToStr := 'тринадцать';

4: CifrToStr := 'четырнадцать';

5: CifrToStr := 'пятнадцать';

6: CifrToStr := 'шестнадцать';

7: CifrToStr := 'семнадцать';

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

9: CifrToStr := 'девятнадцать';

0: CifrToStr := 'десять';

end;

function Rasryad(K: Integer; V: string): string;

{Функция возвращает наименование разряда в зависимости от последних 2 цифр его}

var j: Integer;

begin

j := StrToInt(Copy(v, Length(v), 1));

if (StrToInt(Copy(v, Length(v) - 1, 2)) > 9) and (StrToInt(Copy(v, Length(v) - 1, 2)) < 20) then

case K of

0: Rasryad := '';

1: Rasryad := 'тысяч';

2: Rasryad := 'миллионов';

3: Rasryad := 'миллиардов';

4: Rasryad := 'триллионов';

end

else

case K of

0: Rasryad := '';

1: case j of

1: Rasryad := 'тысяча';

2..4: Rasryad := 'тысячи';

else

Rasryad := 'тысяч';

end;

2: case j of

1: Rasryad := 'миллион';

2..4: Rasryad := 'миллионa';

else

Rasryad := 'миллионов';

end;

3: case j of

1: Rasryad := 'миллиард';

2..4: Rasryad := 'миллиарда';

else

Rasryad := 'миллиардов';

end;

4: case j of

1: Rasryad := 'триллион';

2..4: Rasryad := 'триллиона';

else

Rasryad := 'триллионов';

end;

function GroupToStr(Group: string; Padeg: Integer): string;

{Функция возвращает прописью 3 цифры}

var i: Integer;

S: string;

begin

S := '';

if (StrToInt(Copy(Group, Length(Group) - 1, 2)) > 9) and (StrToInt(Copy(Group, Length(Group) - 1, 2)) < 20) then

begin

if Length(Group) = 3 then

S := S + ' ' + CifrToStr(Copy(Group, 1, 1), 1, Padeg);

S := S + ' ' + CifrToStr(Copy(Group, Length(Group), 1), 4, Padeg);

end

else

for i := 1 to Length(Group) do

S := S + ' ' + CifrToStr(Copy(Group, i, 1), i - Length(Group) + 3, Padeg);

GroupToStr := S;

end;

{Функция возвращает сумму прописью}

function RubToStr(Rubs: Currency; Rub, Kop: string): string;

var i, j: Integer;

R, K, S: string;

begin

S := CurrToStr(Rubs);

S := Trim(S);

if Pos(',', S) = 0 then

begin

R := S;

K := '00';

end

else

begin

R := Copy(S, 0, (Pos(',', S) - 1));

K := Copy(S, (Pos(',', S) + 1), Length(S));

end;

S := '';

i := 0;

j := 1;

while Length(R) > 3 do

begin

if i = 1 then

j := 2

else

j := 1;

S := GroupToStr(Copy(R, Length(R) - 2, 3), j) + ' ' + Rasryad(i, Copy(R, Length(R) - 2, 3)) + ' ' + S;

R := Copy(R, 1, Length(R) - 3);

i := i + 1;

end;

if i = 1 then

j := 2

else

j := 1;

S := Trim(GroupToStr(R, j) + ' ' + Rasryad(i, R) + ' ' + S + ' ' + Rub + ' ' + K + ' ' + Kop);

S := ANSIUpperCase(Copy(S, 1, 1)) + Copy(S, 2, Length(S) - 1);

RubToStr := S;

end;

--------------------------------------------------------------------------------

Вот еще одно решение, присланное Олегом Клюкач.

unit Numinwrd;

interface

function sMoneyInWords(Nin: currency): string; export;

function szMoneyInWords(Nin: currency): PChar; export;

{ Денежная сумма Nin в рублях и копейках прописью

1997, в.2.1, by О.В.Болдырев}

implementation

uses SysUtils, Dialogs, Math;

type

tri = string[4];

mood = 1..2;

gender = (m, f);

uns = array[0..9] of string[7];

tns = array[0..9] of string[13];

decs = array[0..9] of string[12];

huns = array[0..9] of string[10];

nums = array[0..4] of string[8];

money = array[1..2] of string[5];

endings = array[gender, mood, 1..3] of tri; {окончания числительных и денег}

const

units: uns = ('', 'один ', 'два ', 'три ', 'четыре ', 'пять ',

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

unitsf: uns = ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ',

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

teens: tns = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ',

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

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

decades: decs = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ',

'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ',

'девяносто ');

hundreds: huns = ('', 'сто ', 'двести ', 'триста ', 'четыреста ',

'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ',

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

numericals: nums = ('', 'тысяч', 'миллион', 'миллиард', 'триллион');

RusMon: money = ('рубл', 'копе');

ends: endings = ((('', 'а', 'ов'), ('ь', 'я', 'ей')),

(('а', 'и', ''), ('йка', 'йки', 'ек')));

threadvar

str: string;

function EndingIndex(Arg: integer): integer;

begin

if ((Arg div 10) mod 10) <> 1 then

case (Arg mod 10) of

1: Result := 1;

2..4: Result := 2;

else

Result := 3;

end

else

Result := 3;

end;

function sMoneyInWords(Nin: currency): string; { Число Nin прописью, как функция }

var

// str: string;

g: gender; //род

Nr: comp; {целая часть числа}

Fr: integer; {дробная часть числа}

i, iTri, Order: longint; {триада}

procedure Triad;

var

iTri2: integer;

un, de, ce: byte; //единицы, десятки, сотни

function GetDigit: byte;

begin

Result := iTri2 mod 10;

iTri2 := iTri2 div 10;

end;

begin

iTri := trunc(Nr / IntPower(1000, i));

Nr := Nr - int(iTri * IntPower(1000, i));

iTri2 := iTri;

if iTri > 0 then

begin

un := GetDigit;

de := GetDigit;

ce := GetDigit;

if i = 1 then

g := f

else

g := m; {женского рода только тысяча}

str := TrimRight(str) + ' ' + Hundreds[ce];

if de = 1 then

str := TrimRight(str) + ' ' + Teens[un]

else

begin

str := TrimRight(str) + ' ' + Decades[de];

case g of

m: str := TrimRight(str) + ' ' + Units[un];

f: str := TrimRight(str) + ' ' + UnitsF[un];

end;

if length(numericals[i]) > 1 then

begin

str := TrimRight(str) + ' ' + numericals[i];

str := TrimRight(str) + ends[g, 1, EndingIndex(iTri)];

end;

end; //triad is 0 ?

if i = 0 then Exit;

Dec(i);

Triad;

end;

begin

str := '';

Nr := int(Nin);

Fr := round(Nin * 100 + 0.00000001) mod 100;

if Nr > 0 then

Order := trunc(Log10(Nr) / 3)

else

begin

str := 'ноль';

Order := 0

end;

if Order > High(numericals) then

raise Exception.Create('Слишком большое число для суммы прописью');

i := Order;

Triad;

str :=

Format('%s %s%s %.2d %s%s', [Trim(str), RusMon[1], ends[m, 2, EndingIndex(iTri)],

Fr, RusMon[2], ends[f, 2, EndingIndex(Fr)]]);

str[1] := (ANSIUpperCase(copy(str, 1, 1)))[1];

str[Length(str) + 1] := #0;

Result := str;

end;

function szMoneyInWords(Nin: currency): PChar;

begin

sMoneyInWords(Nin);

Result := @(str[1]);

end;

end.

Взято из Советов по Delphi от Валентина Озерова
Сборник Kuliba

Большая просьба: протестировать, лучший вариант я положу в FAQ

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0503 ] [ 17 queries used ] [ Generated: 19.04.24, 01:46 GMT ]