Отправляет email-рассылки с помощью сервиса Sendsay

Мастера DELPHI. Новости мира компонент, FAQ, статьи...

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Октябрь 2004   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

13.577 подписчиков
-18 за неделю
←   Все выпуски   →

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Информационный Канал Subscribe.Ru
Ежедневная рассылка сайта Мастера DELPHI

DELPHIMASTER.ru

Выпуск от 06.10.04 09:18

Лучшее из нашего FAQ   |x|
Как записать сумму прописью? 123 -> сто двадцать три рубля
Не самый лучший вариант, но работает :)


 { Преобразует трехзначное число в строку }
function ConvertToWord(N  : word) : string;
Const
 Sot : array[1..9] of string[13] =
  ('сто','двести','триста','четыреста','пятьсот',
   'шестьсот','семьсот','восемьсот','девятьсот');
 Des : array[2..9] of string[13] =
  ('двадцать','тридцать','сорок','пятьдесят',
   'шестьдесят','семьдесят','восемьдесят','девяносто');
 Edin : array[0..19] of string[13] =
  ('','один','два','три','четыре','пять','шесть','семь',
   'восемь','девять','десять','одиннадцать','двенадцать',
   'тринадцать','четырнадцать','пятнадцать',
   'шестнадцать','семнадцать','восемнадцать','девятнадцать');
Var S  : string;
begin
 S:=''; N:=N mod 1000;
 if N>99 then begin
  S:=Sot[N div 100]+' '; N:=N mod 100;
 end;

if N>19 then begin
  S:=S+Des[N div 10]+' '; N:=N mod 10;
 
 end;
 Result:=S+Edin[N];
end;

{ Возвращает сумму прописью }
function CenaToStr(r : Currency) : string;
Var
 N,k  : longint;
 S  : string;
begin
 N:=trunc(R); S:='';
 if N<>0 then begin
 if N>999999 then begin
  k:=N div 1000000;
  S:=ConvertToWord(k);
  if ((k-(k div 100)*100)>10) and ((k-(k div 100)*100)<20) then S:=S+' миллионов' else
  if (k mod 10)=1 then S:=S+' миллион' else
  if ((k mod 10)>=2)and((k mod 10)<=4) then S:=S+' миллиона' else
   S:=S+' миллионов';
  N:=N mod 1000000;
 end;
 if N>999 then begin
  k:=N div 1000;
  S:=S+' '+ConvertToWord(k);
  if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then S:=S+' тысяч'
else
  if (k mod 10)=1 then begin SetLength(S, Length(S)-2
 ); S:=S+'на тысяча'; end else
  if (!
 k mod 10
)=2 then begin SetLength(S, length(S)-1); S:=S+'е тысячи'; end else
  if ((k mod 10)>=3)and((k mod 10)<=4) then S:=S+' тысячи' else
   S:=S+' тысяч';
  N:=N mod 1000;
 end; k:=N;
 S:=S+' '+ConvertToWord(k);
 if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then S:=S+' рублей' else
 if (k mod 10)=1 then S:=S+' рубль' else
 if (k mod 10)=2 then S:=S+' рубля' else
 if ((k mod 10)>=3)and((k mod 10)<=4) then S:=S+' рубля' else
  S:=S+' рублей';
end;
 if trunc(R)<>R then begin
  k:=round(frac(R)*100);
  S:=S+' '+IntToStr(K);
  if ((k-(k div 100)*100)>10)and((k-(k div 100)*100)<20) then S:=S+' копеек' else
  if (k mod 10)=1 then begin S:=S+'
копейка'; end else
  if (k mod 10)=2 then begin S:=S+' копейки'; end else
  if ((k mod 10)>=3)and((k mod 10)<=4) then S:=S+' копейки' else
   S:=S+' копеек';
 end else S:=S+' 00 копеек'; 
 S:=Trim(S);
 if S<>'' then S[1]:=AnsiUpperCase(S[1])[1];
 result:=S;
end;


Еще вариант от Дмитрия (дан в конференции)

unit sumstr;

interface
uses
SysUtils, StrUtils;

function SumToString(Value : String) : string;

implementation
const a:array[0..8,0..9] of string=(
('','один ','два ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста
','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),
('тысяч ','тысяча ',
 'две тысячи ','три тысячи ','четыре тысячи ','пять тысячь ',!
 'шесть т
ысячь ','семь тысячь ',
'восемь тысячь ','девять тысячь '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),
('миллионов ','один миллион ','два миллиона ','три миллиона ','четыре миллиона ','пять миллионов ',
'шесть миллионов ','семь миллионов ','восемь миллионов ','девять миллионов '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '));
b:array[0..9] of string=
('десять ','одинадцать ','двенадцать ','тринадцать ','четырнадцать ','пятьнадцать ','шестьнадцать ',
'семьнадцать ','восемьнадцать ','девятьнадцать ');
function SumToStrin(Value
: String) : string;
var s,t:string;
   p,pp,i,k:integer;
begin
       s:=value;
       if s='0' then t:='Ноль ' else begin
       p:=length(s);
       pp:=p;
       if p>1 then
       if (s[p-1]='1') and (s[p]>'0') then begin
       t:=b[strtoint(s[p])];pp:=pp-2;end;
       i:=pp;
       while i>0 do begin
       if (i=p-3) and (p>4) then
       if s[p-4]='1' then begin
       t:=b[strtoint(s[p-3])]+'тысяч '+t;i:=i-2;end;
       if (i=p-6) and (p>7) then
       if s[p-7]='1' then begin
       t:=b[strtoint(s[p-6])]+'миллионов '+t;
       i:=i-2;end;
       if i>0 then begin k:=strtoint(s[i]);
       t:=a[p-i,k]+t;
       i:=i-1;end;
       end;end;
       result:=t;
end;
procedure
get2str(value:string;var hi,lo:string);
<
 b>var p:integer;
begin
       p:=pos(',',va!
 lue);
       lo:='';hi:='';
       if p=0 then p:=pos('.',value);
       if p<>0 then delete(value,p,1);
       if p=0 then begin hi:=value;lo:='00';end;
       if p>length(value) then begin hi:=value;lo:='00';end;
       if p=1 then begin hi:='0';lo:=value;end;
       if (p>1) and (pthen
       begin
       hi:=copy(value,1,p-1);
       lo:=copy(value,p,length(value));
       end;
end;

function sumtostring(value:string):string;
var hi,lo:string;
   pr,er:integer;
begin
       get2str(value,hi,lo);
       if (hi='') or (lo='') then begin result:='';exit;end;
       val(hi,pr,er);if er<>0 then begin result:='';exit;end;

      hi:=sumtostrin(inttostr(pr))+'руб. ';
       if lo
 <>'00' then begin
       val(lo,pr,er);if er<>0 then begin result:='';exit;end;
       lo:=inttostr(pr);
       end;
       lo:=lo+' коп. ';
       hi[1]:=AnsiUpperCase(hi[1])[1];
       result:=hi+lo;
end;
end.

»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
У нас большой выбор статей   |x|
Поддержка Windows Visual Styles (Themes) API в Ваших органах управления
В операционных системах (OC) компании Microsoft, начиная с Microsoft Windows XP, появились так называемые визуальные стили (visual styles), которые определяют внешний вид органов управления (controls) и других окон (windows) интерфейса пользователя.
В отличие от более ранних ОС компании Microsoft, органы управления теперь могут иметь не только иные цветовую схему и пропорции, но также иные методы прорисовки отдельных своих элементов оформления (parts).
Сами методы отрисовки различных стандартных элементов были выделены в отдельный модуль с расширением mst, который поставляется в составе визуального стиля. В комплект поставки Windows XP входит только один визуальный стиль ...
Новинки книжного рынка   |x|
Программирование игр для Windows. Советы профессионала (+ CD-ROM)
Книга предназначена для читателей, интересующихся вопросами разработки игр в операционной системе Windows. В ней освещены разнообразные аспекты программирования игр - от азов программирования до серьезного рассмотрения различных компонентов DirectX, от простейших физических моделей до сложных вопросов искусственного интеллекта. Книга будет полезна как начинающим, так и профессиональным разработчикам игр для Windows, хотя определенные знания в области программирования (в частности, языка программирования C или C++), математики и физики существенно облегчат изучение материала.
Автор: Андре Ламот
Опрос населения :)
Как вы относитесь к KOL и MCK?
»»» Отлично.
»»» Никак.
»»» Барахло.
»»» А что это?
Для души

Хокку дня
На голой ветке
Ворон сидит одиноко.
Осенний вечер.

Афоризмы
Читай! Бумага всё стерпит.

Фраза дня
Мы делили апельсин - много наших полегло

Дурацкие законы (информация предоставлена сайтом kurilka.com)
В городе Лонг Бич (США) официальным постановлением признано, что "гаражи строятся для автомобилей".
В Англии до сих пор есть закон, который запрещает владеть телевизором всем, кто не имеет особой лицензии.

И на закуску коротенький анекдот
Встречаются два программиста:
- Говорят, ты женился!
- Да, есть такое дело.
- А как зовут?
- (в задумчивости) Оксана... нет, Татьяна... нет, КОРОЧЕ ICQ# 98745482190 !!!

Фотоприколы.
Начните день с хорошего настроения!
http://www.delphimaster.ru/cgi-bin/prikol.pl?id=112

На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (merlin@delphimaster.ru)

Добро пожаловать на сайт -= Мастера DELPHI =- 
http://subscribe.ru/
http://subscribe.ru/feedback/		 Подписан адрес:
Код этой рассылки: comp.soft.prog.mdelphi		 Отписаться
В избранное