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

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


Информационный Канал Subscribe.Ru

Ежедневная рассылка сайта Мастера DELPHI

DELPHIMASTER.ru

Выпуск от 31.07.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|
  • Проблема использования интерфейса при переводе декларации с C
    Буду признателен за любые идеи, поскольку сам уже несколько дней в тупике. Есть задача - написание плагина на Делфи ...
  • Ошибка с полем дата/время в аксес
    Запрос типа select field from table where data<="01.01.01" в парадоксе работал, а в аксесе 'Несоответствие типов ...
  • D7 и WinXp
    Мастера, посоветуйте! Нужно написать программу, которая будет работать под WinXp, поэтому у меня появился вопрос. ...
  • FreeLibrary
    Загружаю библиотеку в чужой процесс с помощью CreateRemoteThread. library Project2; uses Windows; var a:array[0.....
  • DBGrid
    Доб день! Только вот перехожу на KOL&MCK подскажите плиз какой-нить DBGrid для него есть смотрел на http://kol.mastak....
  • Как дозвониться до провайдера? :)
    Как мне дозвониться, допустим, через подключение по умолчанию. А потом его разорвать. Или, на худой конец, как вызвать ...
  • Проблема с 32 битами на DirectX JEDI, IDirectDraw7
    Я делаю вывод графики средствами DirectX JEDI. Использую IDirectDraw7. Делаю около 500 фаст блиттингов маленькой (64*32 ...
У нас большой выбор статей   |x|
Повторное использование форм в Delphi
Каждый раз, приступая к разработке нового проекта, я ловлю себя на мысли, что когда-то я уже делал подобные формы. Поэтому я решил поделиться несколькими мыслями о повторном использовании форм в Delphi. Я не претендую на авторство описанных ниже методов, однако я еще не встречал статьи, где данный вопрос был освещен достаточно полно...
Новинки книжного рынка   |x|
Программирование баз данных в Delphi 6. Учебный курс (+дискета)
В книге описываются многочисленные визуальные и невизуальные компоненты, а также технологии, использующиеся для создания приложений баз данных. Последовательно рассматриваются три наиболее распространенных архитектуры баз данных — файл-серверная, клиент-серверная и трехзвенная. Многие описываемые технологии могут быть применены и в более ранних версиях пакета Delphi. Книга содержит также значительный объем тщательно отобранной и хорошо организованной справочной информации.
Автор: Фаронов В. В.
Опрос населения :)
Как вы относитесь к KOL и MCK?
»»» Отлично.
»»» Никак.
»»» Барахло.
»»» А что это?
Для души

Хокку дня
Три самурая на зимнем ветру
Саке распивают холодным
Лучше б мы взяли портвейна...

Афоризмы
Ты можешь и не заметить, что у тебя все идет хорошо. Но налоговая служба напомнит (Пьер Данинос)

Фраза дня
Вы имеете право хранить молчание. Все что вы скажете, будет искажено и направлено против вас.

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

И на закуску коротенький анекдот
Кавказские мужчины утверждают, что 100-процентной гарантии не даёт даже презерватив! Потому что в любой момент может войти муж...

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


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

Добро пожаловать на сайт -= Мастера DELPHI =- 

http://subscribe.ru/
http://subscribe.ru/feedback/
Адрес подписки
Отписаться

В избранное