Честно, давно ждал подобного журнала в электронном виде. Решил послать своё творчество которое уже немало отработало, опять же, преобразование числа в пропись, отличающееся от опубликованных программок тем, что слова для прописи хранятся в отдельном файле (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
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!