Содержание материала

 

Честно, давно ждал подобного журнала в электронном виде. Решил послать своё творчество которое уже немало отработало, опять же, преобразование числа в пропись, отличающееся от опубликованных программок тем, что слова для прописи хранятся в отдельном файле (lang.cnf), по аналогии с подуктами 1C. Это позволяет изменять национальную валюту.

 

Если поэкспериментировать, с массивом Univer, в котором хранятся окончания, можно добиться преобразования для многих языков, не сказал ли я чего лишнего. :)

 

Надеюсь, моя версия Вам понравится.

 

С наилучшими пожеланиями,

 

Панченко Сергей

 

Казахстан, Алматы,

 

Code:

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: arrayofstring);

 

var

 

NameNum: array[0..9, 1..4] ofstring; //массив им?н чисел

Ext: array[0..4, 1..3] ofstring; //массив расшиений (тысячи, миллионы ...)

Univer: array[1..9, 1..4] of integer; //массив окончаний

Rubl: array[1..3] ofstring; //массив имен рублей

Cop: array[1..3] ofstring; //массив имен копеек

Zero: string; //название нуля

One: string; //единица "одна"

Two: string; //двойка "две"

fFile: TIniFile; //файл, откуда загружается пропись

fString: string;

fDim: array[0..9] ofstring;

i: integer;

 

implementation

 

{заполняет массив Dim лексемами}

 

procedure LexemsToDim(fstr: string; var dim: arrayofstring);

var

 

i, j: integer;

flex: string;

begin

 

if Length(fstr) > 0then

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

elseif (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 = 4then

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) = 1then

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 = 0then

idx := 5;

idxIP := Univer[idx, 1];

idx := StrToInt(Real_Part[Length(Real_Part)]);

if idx = 0then

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 := 1to9do

NameNum[i, 1] := fdim[i - 1];

 

{Заполнение массива десятков}

fString := fFile.ReadString('Nums', 'Tens', ',');

LexemsToDim(fString, fdim);

NameNum[0, 2] := '';

for i := 1to9do

NameNum[i, 2] := fdim[i - 1];

 

{Заполнение массива сотен}

fString := fFile.ReadString('Nums', 'Hundreds', ',');

LexemsToDim(fString, fdim);

NameNum[0, 3] := '';

for i := 1to9do

NameNum[i, 3] := fdim[i - 1];

 

{Заполнение массива чисел после десяти}

fString := fFile.ReadString('Nums', 'AfterTen', ',');

LexemsToDim(fString, fdim);

NameNum[0, 4] := '';

for i := 1to9do

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 := 1to3do

Ext[1, i] := fdim[i - 1];

 

{Миллионы}

fString := fFile.ReadString('Nums', 'Mill', ',');

LexemsToDim(fString, fdim);

for i := 1to3do

Ext[2, i] := fdim[i - 1];

 

{Миллиарды}

fString := fFile.ReadString('Nums', 'Bill', ',');

LexemsToDim(fString, fdim);

for i := 1to3do

Ext[3, i] := fdim[i - 1];

 

{Триллион}

fString := fFile.ReadString('Nums', 'Thrill', ',');

LexemsToDim(fString, fdim);

for i := 1to3do

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.

 

 

 

 

Code:Lang.cnf

[Nums]

Numbers=один,два,три,четыре,пять,шесть,семь,восемь,девять,

One=одна,

Two=две,

Tens=десять,двадцать,тридцать,сорок,пятьдесят,шестьдесят,семьдесят,восемьдесят,девяносто,

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

AfterTen=одиннадцать,двенадцать,тринадцать,четырнадцать,пятнадцать,шестнадцать,семнадцать,восемнадцать,девятнадцать,

Zero=ноль,

Thou=тысяча,тысяч,тысячи,

Mill=миллион,миллионов,миллиона,

Bill=миллиард,миллиардов,миллиарда,

Thrill=триллион,триллионов,триллиона,

 

[Money]

Rub=рубль,рублей,рубля,

Cop=копейка,копеек,копейки,

 

 

https://delphiworld.narod

DelphiWorld 6.0

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить