На главную страницу
Форум txt.version   




Статья :: Число строкой III
Число строкой III

Вот еще одно решение, присланное читателем.


    unit RoubleUnit;
{$D Пропись c Близнец Антон '99 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 =(''   ,'тысяч','миллион','миллиард','триллион','квадраллион','квинтиллион');
c1000w:array[0..Max000]of Boolean=(False,True   ,False    ,False     ,False     ,False        ,False        );
w:Array[False..True,'0'..'9']of String[3]=(('ов ',' ','а ','а ','а ','ов ','ов ','ов ','ов ','ов '),
(' ' ,'а ','и ','и ','и ',' ',' ',' ',' ',' '));
function Num000toStr(S:String;woman:Boolean):String;{Num000toStr возвращает число для триплета}
const c100:Array['0'..'9']of String=('','сто '   ,'двести '  ,'триста '  ,'четыреста ','пятьсот ','шестьсот ','семьсот '  ,'восемьсот '  ,'девятьсот ');
c10:Array['0'..'9']of String=('','десять ','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто ');
c11:Array['0'..'9']of String=('','один','две','три','четыр','пят','шест','сем','восем','девят');
c1:Array[False..True,'0'..'9']of String=(('','один ','два ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '),
('','одна ','две ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '));
begin{Num000toStr}
Result:=c100[s[1]]+iif((s[2]='1')and(s[3]>'0'),c11[s[3]]+'надцать ',c10[s[2]]+c1[woman,s[3]]);
end;{Num000toStr}

var s000:String[3];
isw,isMinus:Boolean;
i:integer;//Счётчик триплетов
Begin
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 RealToRouble(c:Extended):String;
Const ruble :array['0'..'9']of string[2]=('ей','ь','я','я','я','ей','ей','ей','ей','ей');
Kopeek:array['0'..'9']of string[3]=('ек','йка','йки','йки','йки','ек','ек','ек','ек','ек');

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.

[000237]

Число строкой III

страницы в данном разделе 
 Преобразование ASCII в шестнадцатиричное представление  Преобразование двоичного числа в десятичное
 Перевод из BitMap в Icon  Преобразование '1010' в '001010'
 Преобразование BMP в JPEG в Delphi 3  Декомпилляция звукового файла формата Wave и получение звуковых данных
 dec->hex  HEX -> Integer
 Преобразование ICO в BMP  FAQ Валентинa Озеровa DELPHI
 Число строкой I  Число строкой II
 Число строкой III  Число строкой IV
 Число строкой V  Число строкой VI
 Число строкой VII  Unix-строки (чтение и запись Unix-файлов)


Разделы
Околокомпьютерная литература (375)
Программирование (102)
Программы (75)
ОС и Сети (49)
Интернет (29)
Аппаратное обеспечение (16)
Базы данных (6)

Содержание сайта (выборка)
Apache
Протоколы TCP/IP (принципы, протоколы и архитектура)

PHP, PELR, JSP
PHP
JavaServer Pages (JSP)

Базы данных
Основы mysql
СУБД INFORMIX
СУБД POSTGRES
Основы проектирования реляционных баз данных

HTML, javascript
Спецификация HTML 4.01
Каскадные Таблицы Стилей, Уровень 2
Клиентский JavaScript. Справочник.
JavaScript руководство пользователя
Серверный JavaScript 1.4. Руководство по Использованию.

Паскаль, C, C++, C#
GCC (примеры)
FAQ Валентинa Озеровa DELPHI
C





 
©  programming-lang.com  справочник программиста