Сумма прописью.
PascalScript
Вызов: Propis(124.34)
переделано.
Сам код:
Вызов: Propis(124.34)
переделано.
Сам код:
function Propis(Value0: extended): string;
var
Rend: boolean;
ValueTemp, ValueOst,value, value1,value2: longint;
procedure Num(Value: byte);
begin
case Value of
1: if Rend = true then Result := Result + 'один ' else Result := Result + 'одна ';
2: if Rend = true then Result := Result + 'два ' else Result := Result + 'две ';
3: Result := Result + 'три ';
4: Result := Result + 'четыре ';
5: Result := Result + 'пять ';
6: Result := Result + 'шесть ';
7: Result := Result + 'семь ';
8: Result := Result + 'восемь ';
9: Result := Result + 'девять ';
10: Result := Result + 'десять ';
11: Result := Result + 'одиннадцать ';
12: Result := Result + 'двенадцать ';
13: Result := Result + 'тринадцать ';
14: Result := Result + 'четырнадцать ';
15: Result := Result + 'пятнадцать ';
16: Result := Result + 'шестнадцать ';
17: Result := Result + 'семнадцать ';
18: Result := Result + 'восемнадцать ';
19: Result := Result + 'девятнадцать ';
end
end;
procedure Num10(Value: byte);
begin
case Value of
2: Result := Result + 'двадцать ';
3: Result := Result + 'тридцать ';
4: Result := Result + 'сорок ';
5: Result := Result + 'пятьдесят ';
6: Result := Result + 'шестьдесят ';
7: Result := Result + 'семьдесят ';
8: Result := Result + 'восемьдесят ';
9: Result := Result + 'девяносто ';
end;
end;
procedure Num100(Value: byte);
begin
case Value of
1: Result := Result + 'сто ';
2: Result := Result + 'двести ';
3: Result := Result + 'триста ';
4: Result := Result + 'четыреста ';
5: Result := Result + 'пятьсот ';
6: Result := Result + 'шестьсот ';
7: Result := Result + 'семьсот ';
8: Result := Result + 'восемьсот ';
9: Result := Result + 'девятьсот ';
end
end;
procedure Num00;
begin
Num100(ValueTemp div 100);
ValueTemp := ValueTemp mod 100;
if ValueTemp < 20 then Num(ValueTemp)
else
begin
Num10(ValueTemp div 10);
ValueTemp := ValueTemp mod 10;
Num(ValueTemp);
end;
end;
procedure NumMult(Mult: longint; s1, s2, s3: string);
var ValueRes:longint;
begin
if Value >= Mult then
begin
ValueTemp := Value div Mult;
ValueRes := ValueTemp;
Num00;
if ValueTemp = 1 then Result := Result + s1
else if (ValueTemp > 1) and (ValueTemp < 5) then Result := Result + s2
else Result := Result + s3;
Value := Value - Mult * ValueRes;
end;
end;
function pr(Value:longint):string;
begin
end;
begin
Result:='';
value1:=trunc(Value0);
value2:=trunc(frac(Value0)*100);
value:=value1;
if (Value = 0) then Result := 'ноль'
else
begin
Rend := true;
NumMult(1000000000000, 'триллион ', 'триллиона ', 'триллионов ');
NumMult(1000000000, 'миллиард ', 'миллиарда ', 'миллиардов ');
NumMult(1000000, 'миллион ', 'миллиона ', 'миллионов ');
Rend := false;
NumMult(1000, 'тысяча ', 'тысячи ', 'тысяч ');
Rend := true;
ValueTemp := Value;
Num00;
end;
result:=result+' '+Rub(value1,'рубль;рубля;рублей')+' ';
value:=value2;
if (Value = 0) then Result :=Result+'ноль';
ValueTemp := Value;
Num00;
Result:=result+' '+Kop(value2,'копейка;копейки;копеек');
end;
procedure Fst(S: string; Var S1: string; Var S2: string; Var S3: string);
var
pos: integer;
begin
S1 := '';
S2 := '';
S3 := '';
pos := 1;
while ((pos <= Length(S))and(S[pos] <> ';'))do
begin
S1 := S1 + S[pos];
inc(pos);
end;
inc(pos);
while ((pos <= Length(S))and(S[pos] <> ';'))do
begin
S2 := S2 + S[pos];
inc(pos);
end;
inc(pos);
while ((pos <= Length(S))and(S[pos] <> ';'))do
begin
S3 := S3 + S[pos];
inc(pos);
end;
inc(pos);
end;
function Rub(Value: longint; Skl: string): string;
var
hk10, hk20: integer;
Skl1,Skl2,Skl3: string;
begin
Result :='';
Fst(Skl,Skl1,Skl2,Skl3);
hk10 := Value mod 10;
hk20 := Value mod 100;
if (hk20 > 10) and (hk20 < 20) then result := result + Skl3
else if (hk10 = 1) then result := result + Skl1
else if (hk10 > 1) and (hk10 < 5) then result := result + Skl2
else result := result + Skl3;
end;
function Kop(Value: longint; Skp: string): string;
var
hk10, hk20: integer;
Skp1,Skp2,Skp3: string;
begin
Result :='';
Fst(Skp,Skp1,Skp2,Skp3);
hk10 := Value mod 10;
hk20 := Value mod 100;
if (hk20 > 10) and (hk20 < 20) then result := result + Skp3
else
if (hk10 = 1) then result := result + Skp1
else if (hk10 > 1) and (hk10 < 5) then result := result + Skp2
else result := result + Skp3;
end;
begin
end.
Комментарии
function IntToWords64(k:int64):string;
VAR
Value: Int64;
i100, i10, i1: Integer;
V, p, n: Integer;
res:string;
begin
try
res:='';
Value :=k;
n := 0;
{Обработка отрицательного значения и нуля}
if Value < 0 then
begin
Value := -Value;
res:='минус';
end
else
if Value = 0 then
res:='ноль'+res;
repeat
{Разбивка на триады с конца}
V := Value mod 1000;
Value := Value div 1000;
{Обработка}
if (V > 0) or (n = 0) then
begin
i100 := V div 100;
V := V-(i100*100);
if V >= 20 then
begin
i1 := V mod 10;
V := V div 10;
i10 := V mod 10;
end
else begin
i1 := V;
i10 := 0;
end;
case i1 of
1: p := 0;
2..4: p := 1;
else p := 2;
end;
{Изменение в зависимости от женского или мужского рода}
if (A0[n,3] = '0') and ((i1 = 1) or (i1 = 2)) then
res:=A100[i100]+A10[i10]+A11[i1]+A0[n,p]+' '+res
else res:=A100[i100]+A10[i10]+A1[i1]+A0[n,p]+' '+res;
end;
Inc(n);
{Проверка выхода за максимальное количество триад}
if n > MAX3 then Exit;
until Value <= 0;
except
res:='Ошибка';
end;
result:=res;
end;
//для Inttoworda64
MAX3 = 5; {Максимальное количество триад}
A11: ARRAY[1..2] OF STRING[20] = ('одна ', 'две ');
A1: ARRAY[0..19] OF STRING [20] = ('', 'один ', 'два ','три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять ', 'десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать ');
A10: ARRAY[0..9] OF STRING [20] = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто ');
A100: ARRAY[0..9] OF STRING[20]= ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ');
{четвертым параметром является обозначение мужского или женского рода,
где '0' - женский род;
'1' - мужской род.
Это дает возможность, например, изменяя "рубли" на "штуки" просто поменять '1' на '0' не меняя кода.}
A0: ARRAY[0..MAX3-1, 0..3] OF STRING[20]= (('рубль', 'рубля', 'рублей', '1'),
('тысяча', 'тысячи', 'тысяч', '0'),
('миллион', 'миллиона', 'миллионов', '1'),
('миллиард', 'миллиарда', 'миллиардов', '1'),
('триллион', 'триллиона', 'триллионов', '1'));