Число строкой VII
Здравствуйте Валентин.
Честно, давно ждал подобного журнала в электронном виде. Решил послать своё творчество которое уже немало отработало, опять же, преобразование числа в пропись, отличающееся от опубликованных программок тем, что слова для прописи хранятся в отдельном файле (lang.cnf), по аналогии с подуктами 1C. Это позволяет изменять национальную валюту.
Если поэкспериментировать, с массивом Univer, в котором хранятся окончания, можно добиться преобразования для многих языков, не сказал ли я чего лишнего. :)
Надеюсь, моя версия Вам понравится.
С наилучшими пожеланиями,
Панченко Сергей
Казахстан, Алматы,
Sergey@arna.kz
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=копейка,копеек,копейки, |
[000562]
