unit RoubleUnit;

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;

end.

Uses Math;

Function RoundMax(Num:real; prec:integer):real;

begin

result:=roundto(num+Power(10, prec-1)*5, prec);

end;

Function RoundMax100(Num:real):real;

begin

result:=round(num0+0.5)/100;

end;

function BinToInt(const Value: string): Integer;

var

i, strLen: Integer;

begin

Result := 0;

strLen := Length(Value);

for i := 1 to strLen do

if Value[i] = '1' then

Result := Result or (1 shl (strLen - i))

else

Result := Result and not (1 shl (strLen - i));

end;

function dec2hex(value: dword): string[8];

const

hexdigit = '0123456789ABCDEF';

begin

while value <> 0 do

begin

dec2hex := hexdigit[succ(value and $F)];

value := value shr 4;

end;

if dec2hex = '' then dec2hex := '0';

end;

var

i: integer

s: string;

begin

s := '$' + ThatHexString;

i := StrToInt(a);

end;

const HEX: array['A'..'F'] of INTEGER = (10, 11, 12, 13, 14, 15);

var str: string;

Int, i: integer;

begin

READLN(str);

Int := 0;

for i := 1 to Length(str) do

if str[i] < 'A' then

Int := Int * 16 + ORD(str[i]) - 48

else

Int := Int * 16 + HEX[str[i]];

WRITELN(Int);

READLN;

end.

{ >> Конвертация : Римские -> арабские ; Арабские->Римские}

Const

R: Array[1..13] of String[2] =

('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');

A: Array[1..13] of Integer=

(1,4,5,9,10,40,50,90,100,400,500,900,1000);



..............



Function RomanToArabic(S : String) : Integer; //Римские в арабские

var

i, p : Integer;

begin

Result := 0;

i := 13;

p := 1;

While p <=Length(S) do

begin

While Copy(S, p, Length(R[i])) <>R[i] do

begin

Dec(i);

If i = 0 then Exit;

end;

Result := Result + A[i];

p := p + Length(R[i]);

end;

end;

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;

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;

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;

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;