Сумма прописью - Способ 11
Автор: Панченко Сергей
Честно, давно ждал подобного журнала в электронном виде. Решил послать своё
творчество которое уже немало отработало, опять же, преобразование числа в
пропись, отличающееся от опубликованных программок тем, что слова для прописи
хранятся в отдельном файле (lang.cnf), по аналогии с подуктами 1C. Это позволяет
изменять национальную валюту.
Если поэкспериментировать, с массивом Univer, в котором хранятся окончания,
можно добиться преобразования для многих языков, не сказал ли я чего лишнего. :)
Надеюсь, моя версия Вам понравится.
С наилучшими пожеланиями,
Панченко Сергей
Казахстан, Алматы,
BuchUtil.pas
unit BuchUtil;
interface
uses IniFiles, SysUtils;
function DoubleChar(ch: string): string;
function NumToSampl(N: string): string;
function MoneyToSampl(M: Currency): string;
procedure LexemsToDim(fstr: string; var dim: array of string);
var
NameNum: array[0..9, 1..4] of string; //массив им?н чисел
Ext: array[0..4, 1..3] of string; //массив расшиений (тысячи, миллионы ...)
Univer: array[1..9, 1..4] of integer; //массив окончаний
Rubl: array[1..3] of string; //массив имен рублей
Cop: array[1..3] of string; //массив имен копеек
Zero: string; //название нуля
One: string; //единица "одна"
Two: string; //двойка "две"
fFile: TIniFile; //файл, откуда загружается пропись
fString: string;
fDim: array[0..9] of string;
i: integer;
implementation
{заполняет массив Dim лексемами}
procedure LexemsToDim(fstr: string; var dim: array of string);
var
i, j: integer;
flex: string;
begin
if Length(fstr) > 0 then
begin
i := 1;
j := 0;
while i - 1 < Length(fstr) do
begin
if fstr[i] = ',' then
begin
dim[j] := flex + ' ';
inc(j);
flex := '';
end
else
flex := flex + fstr[i];
inc(i);
end;
end;
end;
{преобразует число в пропись
процедура использует файл lang.cnf}
function NumToSampl(N: string): string;
var
k, i, i_indx: integer;
number, string_num: string;
index: integer;
pos: integer;
fl_ext: boolean;
begin
fl_ext := true;
i := 1;
String_num := '';
number := Trim(N);
k := length(number);
if (k = 1) and (number = '0') then
String_num := Zero
else
begin
pos := 0;
while (k > 0) do
begin
if (k <> 1) and (i = 1) and (length(number) <> 1) and (copy(number, k - 1,
1) = '1')
and (copy(number, k, 1) <> '0') then
begin
index := StrToInt(copy(number, k, 1));
dec(k);
inc(i);
i_indx := 4;
end
else
begin
index := StrToInt(copy(number, k, 1));
i_indx := i;
end;
if (NameNum[index, i_indx] <> '') and (fl_ext = true) then
begin
String_num := Ext[pos, Univer[index, i_indx]] + String_num;
fl_ext := false;
end;
if (index = 1) and (pos = 1) and (i = 1) then
String_num := One + String_num
else if (index = 2) and (pos = 1) and (i = 1) then
String_num := Two + String_num
else
String_num := NameNum[index, i_indx] + String_num;
inc(i);
if i = 4 then
begin
i := 1;
inc(pos);
fl_ext := true
end;
dec(k);
end;
end;
if Trim(String_Num) <> '' then
begin
String_num[1] := CHR(ORD(String_num[1]) - 32);
Result := String_num;
end;
end;
{Преобразует х в 0х}
function DoubleChar(ch: string): string;
begin
if Length(ch) = 1 then
Result := '0' + ch
else
Result := ch;
end;
{преобразует денежную сумму в пропись}
function MoneyToSampl(M: Currency): string;
var
Int_Part, idx, idxIP, idxRP: integer;
Int_Str, Real_Part, Sampl: string;
begin
Int_Part := Trunc(Int(M));
Int_Str := IntToStr(Int_Part);
Real_Part := DoubleChar(IntToStr(Trunc(Int((M - Int_Part + 0.001) * 100))));
Sampl := NumToSampl(Int_Str);
idx := StrToInt(Int_Str[Length(Int_Str)]);
if idx = 0 then
idx := 5;
idxIP := Univer[idx, 1];
idx := StrToInt(Real_Part[Length(Real_Part)]);
if idx = 0 then
idx := 5;
idxRP := Univer[idx, 1];
Result := Sampl + Rubl[idxIP] + Real_Part + ' ' + Cop[idxRP];
end;
initialization
{Предположим файл находится на C:\ диске}
fFile := TIniFile.Create('c:\lang.cnf');
try
{Заполнение массива рублей}
fString := fFile.ReadString('Money', 'Rub', ',');
LexemsToDim(fString, Rubl);
{Заполнение массива копеек}
fString := fFile.ReadString('Money', 'Cop', ',');
LexemsToDim(fString, Cop);
{Заполнение массива чисел}
fString := fFile.ReadString('Nums', 'Numbers', ',');
LexemsToDim(fString, fdim);
NameNum[0, 1] := '';
for i := 1 to 9 do
NameNum[i, 1] := fdim[i - 1];
{Заполнение массива десятков}
fString := fFile.ReadString('Nums', 'Tens', ',');
LexemsToDim(fString, fdim);
NameNum[0, 2] := '';
for i := 1 to 9 do
NameNum[i, 2] := fdim[i - 1];
{Заполнение массива сотен}
fString := fFile.ReadString('Nums', 'Hundreds', ',');
LexemsToDim(fString, fdim);
NameNum[0, 3] := '';
for i := 1 to 9 do
NameNum[i, 3] := fdim[i - 1];
{Заполнение массива чисел после десяти}
fString := fFile.ReadString('Nums', 'AfterTen', ',');
LexemsToDim(fString, fdim);
NameNum[0, 4] := '';
for i := 1 to 9 do
NameNum[i, 4] := fdim[i - 1];
{Заполнение расширений чисел}
Ext[0, 1] := '';
Ext[0, 2] := '';
Ext[0, 3] := '';
{Тысячи}
fString := fFile.ReadString('Nums', 'Thou', ',');
LexemsToDim(fString, fdim);
for i := 1 to 3 do
Ext[1, i] := fdim[i - 1];
{Миллионы}
fString := fFile.ReadString('Nums', 'Mill', ',');
LexemsToDim(fString, fdim);
for i := 1 to 3 do
Ext[2, i] := fdim[i - 1];
{Миллиарды}
fString := fFile.ReadString('Nums', 'Bill', ',');
LexemsToDim(fString, fdim);
for i := 1 to 3 do
Ext[3, i] := fdim[i - 1];
{Триллион}
fString := fFile.ReadString('Nums', 'Thrill', ',');
LexemsToDim(fString, fdim);
for i := 1 to 3 do
Ext[4, i] := fdim[i - 1];
Zero := fFile.ReadString('Nums', 'Zero', '0');
if Zero[Length(Zero)] = ',' then
Zero := Copy(Zero, 1, Length(Zero) - 1) + ' ';
One := fFile.ReadString('Nums', 'One', '1');
if One[Length(One)] = ',' then
One := Copy(One, 1, Length(One) - 1) + ' ';
Two := fFile.ReadString('Nums', 'Two', '0');
if Two[Length(Two)] = ',' then
Two := Copy(Two, 1, Length(Two) - 1) + ' ';
{Заполнение таблицы окончаний}
Univer[1, 1] := 1;
Univer[1, 2] := 2;
Univer[1, 3] := 2;
Univer[1, 4] := 2;
Univer[2, 1] := 3;
Univer[2, 2] := 2;
Univer[2, 3] := 2;
Univer[2, 4] := 2;
Univer[3, 1] := 3;
Univer[3, 2] := 2;
Univer[3, 3] := 2;
Univer[3, 4] := 2;
Univer[4, 1] := 3;
Univer[4, 2] := 2;
Univer[4, 3] := 2;
Univer[4, 4] := 2;
Univer[5, 1] := 2;
Univer[5, 2] := 2;
Univer[5, 3] := 2;
Univer[5, 4] := 2;
Univer[6, 1] := 2;
Univer[6, 2] := 2;
Univer[6, 3] := 2;
Univer[6, 4] := 2;
Univer[7, 1] := 2;
Univer[7, 2] := 2;
Univer[7, 3] := 2;
Univer[7, 4] := 2;
Univer[8, 1] := 2;
Univer[8, 2] := 2;
Univer[8, 3] := 2;
Univer[8, 4] := 2;
Univer[9, 1] := 2;
Univer[9, 2] := 2;
Univer[9, 3] := 2;
Univer[9, 4] := 2;
finally
fFile.Free;
end;
end.
|
Lang.cnf
[Nums]
Numbers=один,два,три,четыре,пять,шесть,семь,восемь,девять,
One=одна,
Two=две,
Tens=десять,двадцать,тридцать,сорок,пятьдесят,шестьдесят,семьдесят,восемьдесят,девяносто,
Hundreds=сто,двести,триста,четыреста,пятьсот,шестьсот,семьсот,восемьсот,девятьсот,
AfterTen=одиннадцать,двенадцать,тринадцать,четырнадцать,пятнадцать,шестнадцать,семнадцать,восемнадцать,девятнадцать,
Zero=ноль,
Thou=тысяча,тысяч,тысячи,
Mill=миллион,миллионов,миллиона,
Bill=миллиард,миллиардов,миллиарда,
Thrill=триллион,триллионов,триллиона,
[Money]
Rub=рубль,рублей,рубля,
Cop=копейка,копеек,копейки,
|
|
