Главная / DELPHI / Часто задаваемые вопросы и ответы на них / Object Pascal / Как записать сумму прописью? 123 -> сто двадцать три рубля

Как записать сумму прописью? 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);
var p:integer;
begin
       p:=pos(',',value);
       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.

Copyright ©   "Мастера DELPHI"   E-mail:   delphi@mastak.com  http://www.delphimaster.ru

Источник получения информации: http://www.delphimaster.ru