dash 08.01.2012 12:26

unit SumTxt;

interface

Const
Units: array[1..20] of string =
(' ', ' один', ' два', ' три', ' четыре', ' пять', ' шесть',
' семь', ' восемь', ' девять', ' десять', ' одиннадцать',
' двенадцать', ' тринадцать', ' четырнадцать', ' пятнадцать',
' шестнадцать', ' семнадцать', ' восемнадцать', ' девятнадцать');
UnitsTh: array[1..20] of string =
(' ', ' одна', ' две', ' три', ' четыре', ' пять', ' шесть',
' семь', ' восемь', ' девять', ' десять', ' одиннадцать',
' двенадцать', ' тринадцать', ' четырнадцать', ' пятнадцать',
' шестнадцать', ' семнадцать', ' восемнадцать', ' девятнадцать');
Tens: array[1..10] of string =
(' ', ' десять', ' двадцать', ' тридцать', ' сорок', ' пятьдесят',
' шестьдесят', ' семьдесят', ' восемьдесят', ' девяносто');
Hunds: array[1..10] of string =
(' ', ' сто', ' двести', ' триста', ' четыреста', ' пятьсот',
' шестьсот', ' семьсот', ' восемьсот', ' девятьсот');
Mlrd_znak: array[1..3] of string =
(' миллиард', ' миллиарда', ' миллиардов');
Mln_znak: array[1..3] of string =
(' миллион', ' миллиона', ' миллионов');
Mil_znak: array[1..3] of string =
(' тысяча', ' тысячи', ' тысяч');
RubStr: array[1..3] of string =
('рубль', 'рубля', 'рублей');
KopStr: array[1..3] of string =
('копейка', 'копейки', 'копеек');
DolStr: array[1..3] of string =
('доллар США', 'доллара США', 'долларов США');
CentStr: array[1..3] of string =
('цент', 'цента', 'центов');

// Функция преобразования суммы числом в строку. TypeVal = 1 — рубли, 2 — доллары.
function SumText(SumN: real; TypeVal: integer): string;

implementation

uses SysUtils;

function SumText(SumN: real; TypeVal: integer): string;
var
index, indexr, summ, summ_m: integer;
ten, SH: real;
strOut, strWork: string;
begin
ten:=10;
strOut:='';
SH:=100000000000.0;
index:=-1;
indexr:=3;
// — 100.000.000.000 ---
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
index:=3;
strOut:=strOut+Hunds[summ+1];
SumN:=SumN-summ*SH
end;
SH:=SH / ten;
// — 10.000.000.000 ---
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
index:=3;
summ_m:=Trunc(SumN / Trunc(SH / ten));
If (summ_m<20) Then
begin
strOut:=strOut+Units[summ_m+1];
SumN:=SumN-summ_m*SH / ten
end
else
begin
strOut:=strOut+Tens[summ+1];
SumN:=SumN-summ*SH
end
end;
SH:=SH / ten;
// — 1.000.000.000 ---
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
If (summ>=5) Then
index:=3
else
if (summ=1) Then
index:=1
else
index:=2;
strOut:=strOut+Units[summ+1];
SumN:=SumN-summ*SH
end;
If (index<>-1) Then
strOut:=strOut+Mlrd_znak[index];
SH:=SH / ten;
// — 100.000.000 ---
index:=-1;
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
index:=3;
strOut:=strOut+Hunds[summ+1];
SumN:=SumN-summ*SH
end;
SH:=SH / ten;
// — 10.000.000 ---
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
index:=3;
summ_m:=Trunc(SumN / Trunc(SH / ten));
If (summ_m<20) Then
begin
strOut:=strOut+Units[summ_m+1];
SumN:=SumN-summ_m*SH / ten
end
else
begin
strOut:=strOut+Tens[summ+1];
SumN:=SumN-summ*SH
end
end;
SH:=SH / ten;
// — 1.000.000 ---
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
If (summ>=5) Then
index:=3
else
if (summ=1) Then
index:=1
else
index:=2;
strOut:=strOut+Units[summ+1];
SumN:=SumN-summ*SH
end;
If (index<>-1) Then
strOut:=strOut+Mln_znak[index];
SH:=SH / ten;
// — 100.000 ---
index:=-1;
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
index:=3;
strOut:=strOut+Hunds[summ+1];
SumN:=SumN-summ*SH
end;
SH:=SH / ten;
// — 10.000 ---
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
index:=3;
summ_m:=Trunc(SumN / Trunc(SH / ten));
If (summ_m<20) Then
begin
strOut:=strOut+UnitsTh[summ_m+1];
SumN:=SumN-summ_m*SH / ten
end
else
begin
strOut:=strOut+Tens[summ+1];
SumN:=SumN-summ*SH
end
end;
SH:=SH / ten;
// — 1.000 ---
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
If (summ>=5) Then
index:=3
else
if (summ=1) Then
index:=1
else
index:=2;
strOut:=strOut+UnitsTh[summ+1];
SumN:=SumN-summ*SH
end;
If (index<>-1) Then
strOut:=strOut+Mil_znak[index];
SH:=SH / ten;
// — 100 ---
index:=-1;
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
index:=3;
strOut:=strOut+Hunds[summ+1];
SumN:=SumN-summ*SH
end;
SH:=SH / ten;
// — 10 ---
summ:=Trunc(SumN / SH);
If (summ>=1) Then
begin
index:=3;
summ_m:=Trunc(SumN);
If (summ_m<20) Then
summ:=summ_m
else
begin
strOut:=strOut+Tens[summ+1];
SumN:=SumN-summ*SH
end
end;
// — 1 ---
summ:=Trunc(SumN);
If (summ>0) and (summ<20) Then
begin
If (summ>=5) Then
index:=3
else
if (summ=1) Then
index:=1
else
index:=2;
strOut:=strOut+Units[summ+1]
end;
If (index<>-1) Then
indexr:=index;
If (strOut='') Then
strOut:='ноль';
{ If (TypeVal = 1) Then
strOut:=strOut + ' ' + RubStr[indexr]+' '
else
If (TypeVal = 3) Then
strOut:=strOut + ' ' + DolStr[indexr]+' по расчетам с Индией '
else
strOut:=strOut + ' ' + DolStr[indexr]+' ';
// — 0.10 ---
If (((SumN+0.00000001)-summ)*100 < 10) Then
strOut:=strOut+'0';
SumN:=(SumN-summ)*100;
strOut:=strOut+IntToStr(Round(SumN));
indexr:=3;
summ:=Trunc(SumN/ten);
If (summ>=1) Then
If (StrToInt(FloatToStrF(SumN, ffFixed, 3, 0))>20) Then
SumN:=SumN-summ*10;
// — 0.01 ---
summ:=Round(SumN);
If (summ>=5) Then
indexr:=3
else
if (summ=1) Then
indexr:=1
else
if (summ <> 0) Then
indexr:=2;
} If (TypeVal = 1) Then
strOut:=TrimLeft(strOut{ + ' ' + KopStr[indexr]})
else
strOut:=TrimLeft(strOut + ' ' + CentStr[indexr]);
strWork:=strOut;
strWork:=AnsiUpperCase(strWork);
strOut[1]:=strWork[1];
SumText:=strOut
end;

end.

Do you really want to delete ?