http:\\anton-bl.chat.ru\delphi\1001.htm } { 1000011.01->'Один миллион одинадцать рублей 01 копейка' } interface Function RealToRouble(c:Extended):String; implementation uses SysUtils,math; const Max000 = 6;{Кол-во триплетов - 000}
MaxPosition=Max000*3;{Кол-во знаков в числе }//Аналог IIF в Dbase есть в proc.pas для основных типов, частично объявлена тут для независимости function IIF(i:Boolean;s1,s2:Char ):Char ;overload;begin if i then result:=s1 else result:=s2 end; function IIF(i:Boolean;s1,s2:String ):String ;overload;begin if i then result:=s1 else result:=s2 end;
Function NumToStr(s:String):String;{Возвращает число прописью} Const c1000 :array[0..Max000]of string =('' ,'тысяч','миллион','миллиард','триллион','квадраллион','квинтиллион');
Result:='';i:=0; isMinus:=(s<>'') and (s[1]='-'); if isMinus then s:=Copy(s,2,Length(s)-1); while not((i>=Ceil(Length(s)/3))or(i>=Max000)) do begin s000:=Copy('00'+s,Length(s)-i*3,3); isw:=c1000w[i]; if (i>0)and(s000<>'000') then//тысячи и т.д. Result:=c1000[i]+w[Isw,iif(s000[2]='1','0',s000[3])]+Result; Result:=Num000toStr(s000,isw)+Result; Inc(i) end; if Result='' then Result:='ноль'; if isMinus then Result:='минус '+Result;End;{NumToStr}
Function ending(const s:String):Char; var l:Integer;//С l на 8 байт коротче $50->$48->$3F begin//Возвращает индекс окончания l:=Length(s); Result:=iif((l>1) and (s[l-1]='1'),'0',s[l]); end; var rub:String[MaxPosition+3]; kop:String[2]; begin{Возвращает число прописью с рублями и копейками}
Str(c:MaxPosition+3:2,Result); if Pos('E',Result)=0 then//Если число можно представить в строке <>1E+99 begin rub:=TrimLeft(Copy(Result,1,Length(Result)-3)); kop:= Copy(Result,Length(Result)-1,2) ; Result:=NumToStr(rub)+' рубл'+ ruble[ending(rub)] +' '+ kop +' копе'+Kopeek[ending(kop)]; Result:=AnsiUpperCase(Result[1])+Copy(Result,2,Length(Result)-1); end;end; end.
