powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Сумма прописью
7 сообщений из 7, страница 1 из 1
Сумма прописью
    #32130375
vislex
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Здравствуйте!

Посоветуйте пожалуйста 100% работающую функцию для получения суммы прописью. Кто какие функции использует?

Спасибо
С Уважением, Алексей
...
Рейтинг: 0 / 0
Сумма прописью
    #32130378
Фотография Cooper
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
/topic/19377
...
Рейтинг: 0 / 0
Сумма прописью
    #32130383
alexia
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Есть у меня сырники, правда никогда не пользовался... Попробуй


Код: plaintext
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.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
function CifrToStr(Cifr:String;Pr:Integer;Padeg:Integer) : string;
{Функция возвращает прописью  1  цифры признак  3 -единицы  2 -десятки  1 -сотни  4 - 11 - 19 

Padeg -  1 -нормально  2 - одна, две }
var i:Integer;
begin

i:=StrToInt(Cifr);
if Pr =  1  Then
case i of
 1 : CifrToStr :='сто';
 2 : CifrToStr :='двести';
 3 : CifrToStr :='триста';
 4 : CifrToStr :='четыреста';
 5 : CifrToStr :='пятьсот';
 6 : CifrToStr :='шестьсот';
 7 : CifrToStr :='семьсот';
 8 : CifrToStr :='восемьсот';
 9 : CifrToStr :='девятьсот';
 0 : CifrToStr :='';
end
else if Pr =  2  Then
case i of
 1 : CifrToStr :='';
 2 : CifrToStr :='двадцать';
 3 : CifrToStr :='тридцать';
 4 : CifrToStr :='сорок';
 5 : CifrToStr :='пятьдесят';
 6 : CifrToStr :='шестьдесят';
 7 : CifrToStr :='семьдесят';
 8 : CifrToStr :='восемьдесят';
 9 : CifrToStr :='девяносто';
 0 : CifrToStr :='';
end
else if Pr =  3  Then
case i of
 1 : if Padeg = 1  Then CifrToStr :='один'
else CifrToStr :='одна';
 2 : if Padeg = 1  Then CifrToStr :='два'
else CifrToStr :='две';
 3 : CifrToStr :='три';
 4 : CifrToStr :='четыре';
 5 : CifrToStr :='пять';
 6 : CifrToStr :='шесть';
 7 : CifrToStr :='семь';
 8 : CifrToStr :='восемь';
 9 : CifrToStr :='девять';
 0 : CifrToStr :='';
end
else if Pr =  4  Then
case i of
 1 : CifrToStr :='одиннадцать';
 2 : CifrToStr :='двенадцать';
 3 : CifrToStr :='тринадцать';
 4 : CifrToStr :='четырнадцать';
 5 : CifrToStr :='пятнадцать';
 6 : CifrToStr :='шестнадцать';
 7 : CifrToStr :='семнадцать';
 8 : CifrToStr :='восемнадцать';
 9 : CifrToStr :='девятнадцать';
 0 : CifrToStr :='десять';


end;
end;

function Rasryad(K:Integer;V:String) : string;
{Функция возвращает наименование разряда в зависимости от последних  2  цифр его}
Var j:Integer;
Begin

j := StrToInt(Copy(v,Length(v), 1 ));
if (StrToInt(Copy(v,Length(v)- 1 , 2 ))>  9 ) And (StrToInt(Copy(v,Length(v)- 1 , 2 ))<  20 ) Then
case K of
 0 : Rasryad :='';
 1 : Rasryad :='тысяч';
 2 : Rasryad :='миллионов';
 3 : Rasryad :='миллиардов';
 4 : Rasryad :='триллионов';
end
else
case K of
 0 : Rasryad :='';
 1 : case j of
 1 : Rasryad :='тысяча';
 2 .. 4 : Rasryad :='тысячи';
else
Rasryad :='тысяч';
end;
 2 : case j of
 1 : Rasryad :='миллион';
 2 .. 4 : Rasryad :='миллионa';
else
Rasryad :='миллионов';
end;
 3 : case j of
 1 : Rasryad :='миллиард';
 2 .. 4 : Rasryad :='миллиарда';
else
Rasryad :='миллиардов';
end;
 4 : case j of
 1 : Rasryad :='триллион';
 2 .. 4 : Rasryad :='триллиона';
else
Rasryad :='триллионов';
end;
end;
end;


function GroupToStr(Group:String;Padeg:Integer) : string;
{Функция возвращает прописью  3  цифры}
var i:Integer;

S:String;
begin

S:='';
if (StrToInt(Copy(Group,Length(Group)- 1 , 2 ))>  9 ) And (StrToInt(Copy(Group,Length(Group)- 1 , 2 ))<  20 ) Then
begin
if Length(Group) =  3  Then
S := S+' '+CifrToStr(Copy(Group, 1 , 1 ), 1 ,Padeg);
S := S+' '+CifrToStr(Copy(Group,Length(Group), 1 ), 4 ,Padeg);
end
else
for i:= 1  to Length(Group) do
S := S+' '+CifrToStr(Copy(Group,i, 1 ),i-Length(Group)+ 3 ,Padeg);
GroupToStr:=S;
end;


{Функция возвращает сумму прописью}
function RubToStr(Rubs:Currency;Rub,Kop:String) : string;
var i,j:Integer;

R,K,S:String;
begin

S := CurrToStr(Rubs);
S := Trim(S);
if Pos(',',S) =  0  Then
begin
R:= S;
K:= '00';
end
else
begin
R:= Copy(S, 0 ,(Pos(',',S)- 1 ));
K:= Copy(S,(Pos(',',S)+ 1 ),Length(S));
end;


S :='';
i:=  0 ;
j :=  1 ;
While Length(R) > 3  Do
Begin
if i =  1  Then j := 2 
else j:= 1 ;
S := GroupToStr(Copy(R,Length(R)- 2 , 3 ),j) +' '+Rasryad(i,Copy(R,Length(R)- 2 , 3 ))+ ' ' +S;
R := Copy(R, 1 ,Length(R)- 3 );
i:=i+ 1 ;
end;
if i =  1  Then j := 2 
else j:= 1 ;
S := Trim( GroupToStr(R,j)+' '+Rasryad(i,R) + ' ' +S +' '+Rub+' '+K+' '+Kop);
S := ANSIUpperCase(Copy(S, 1 , 1 )) + Copy(S, 2 ,Length(S)- 1 );
RubToStr := S;
end; 
...
Рейтинг: 0 / 0
Сумма прописью
    #32130394
mitritch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Попробуй это. Хочешь далай DLL, а хочешь подключай так...
unit MonToStr;

interface
function sMoneyInWords( Nin: currency ): string; export;
function szMoneyInWords( Nin: currency ): PChar; export;
{ Денежная сумма Nin в рублях и копейках прописью
1997, в.2.1, by О.В.Болдырев}
var
Result : integer;

implementation
uses SysUtils,Dialogs,Math;

type
tri=string;
mood=1..2;
gender=(m,f);
uns =array[0..9] of string[7];
tns =array[0..9] of string[13];
decs=array[0..9] of string[12];
huns=array[0..9] of string[10];
nums=array[0..4] of string[8];
money=array[1..2] of string[5];
endings=array[gender,mood,1..3] of tri;{окончания числительных и денег}

const
units:uns =('','один ','два ','три ','четыре ','пять ',
'шесть ','семь ','восемь ','девять ');
unitsf:uns=('','одна ','две ','три ','четыре ','пять ',
'шесть ','семь ','восемь ','девять ');
teens:tns= ('десять ','одиннадцать ','двенадцать ','тринадцать ',
'четырнадцать ','пятнадцать ','шестнадцать ',
'семнадцать ','восемнадцать ','девятнадцать ');
decades:decs=('','десять ','двадцать ','тридцать ','сорок ',
'пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ',
'девяносто ');
hundreds:huns=('','сто ','двести ','триста ','четыреста ',
'пятьсот ','шестьсот ','семьсот ','восемьсот ',
'девятьсот ');
numericals:nums=('','тысяч','миллион','миллиард','триллион');
RusMon:money=('рубл','копе');
ends:endings=((('','а','ов'),('ь','я','ей')),
(('а','и',''),('йка','йки','ек')));
threadvar
str: string;

function EndingIndex(Arg: integer): integer;
begin
if ((Arg div 10) mod 10) <> 1 then
case (Arg mod 10) of
1: Result := 1;
2..4: Result := 2;
else Result := 3;
end
else
Result := 3;
end;

function sMoneyInWords( Nin: currency ): string; { Число Nin прописью, как функция }
var
// str: string;
g: gender; //род
Nr: comp; {целая часть числа}
Fr: integer; {дробная часть числа}
i,iTri,Order: longint; {триада}

procedure Triad;
var
iTri2: integer;
un, de, ce :byte; //единицы, десятки, сотни

function GetDigit: byte;
begin
Result := iTri2 mod 10;
iTri2 := iTri2 div 10;
end;

begin
iTri := trunc(Nr/IntPower(1000,i));
Nr := Nr - int( iTri*IntPower(1000,i));
iTri2:=iTri;
if iTri > 0 then
begin
un := GetDigit;
de := GetDigit;
ce := GetDigit;
if i=1 then g:=f
else g:=m; {женского рода только тысяча}

str := TrimRight(str)+' '+Hundreds[ce];
if de = 1 then
str := TrimRight(str)+' '+Teens[un]
else
begin
str := TrimRight(str)+' '+Decades[de];
case g of
m: str := TrimRight(str)+' '+Units[un];
f: str := TrimRight(str)+' '+UnitsF[un];
end;
end;

if length(numericals ) > 1 then
begin
str := TrimRight(str)+' '+numericals;
str := TrimRight(str)+ends[g,1,EndingIndex(iTri)];
end;
end; //triad is 0 ?

if i=0 then Exit;
Dec(i);
Triad;
end;

begin
str := '';
Nr := int( Nin );
Fr := round( Nin*100 + 0.00000001 ) mod 100;
if Nr>0 then Order := trunc(Log10(Nr)/3)
else
begin
str := 'ноль';
Order := 0
end;
if Order > High(numericals) then
raise Exception.Create('Слишком большое число для суммы прописью');
i:= Order;
Triad;
str :=
Format('%s %s%s %.2d %s%s', [Trim(str),RusMon,ends[m,2,EndingIndex(iTri)],
Fr, RusMon,ends[f,2,EndingIndex(Fr)]]);
str := (ANSIUpperCase(copy(str,1,1)));
str[Length(str)+1] := #0;
Result := str;
end;

function szMoneyInWords( Nin: currency ): PChar;
begin
sMoneyInWords(Nin);
Result := @(str);
end;

end.
...
Рейтинг: 0 / 0
Сумма прописью
    #32130538
Фотография KirillovA
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А у меня короче :)) :
Код: plaintext
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.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
//деньги строкой
var
  NumEd: array[ 1 .. 19 ] of string = ('один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять ', 'десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать ');
  NumEd1: array[ 1 .. 2 ] of string = ('одна ', 'две ');
  NumDec: array[ 2 .. 9 ] of string = ('двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто ');
  NumSot: array[ 1 .. 9 ] of string = ('сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ');
  Xlion0: array[ 1 .. 3 ] of string = ('тысяч ', 'миллионов ', 'миллиардов ');
  Xlion1: array[ 1 .. 3 ] of string = ('тысяча ', 'миллион ', 'миллиард ');
  Xlion2: array[ 1 .. 3 ] of string = ('тысячи ', 'миллиона ', 'миллиарда ');
function MoneyToString(Money: Double): string;
var Money3, MoneyI, MoneyK, Digit, LastDigit, T: Integer;
  Sto, Kop: string;
begin
  Result := '';
  MoneyI := Trunc(Money);
  MoneyK := Round((Money - MoneyI) *  100 );
  T :=  0 ;
  while MoneyI >  0  do begin
    Money3 := MoneyI mod  1000 ;
    MoneyI := MoneyI div  1000 ;
    Sto := '';
    if (Money3 mod  100 ) <  20  then begin
      LastDigit := Money3 mod  20 ;
      if LastDigit >  0  then
        if (T =  1 ) and (LastDigit in [ 1 .. 2 ]) then Sto := NumEd1[LastDigit]
        else Sto := NumEd[LastDigit];
      Money3 := Money3 div  100 ;
    end else begin
      LastDigit := Money3 mod  10 ;
      if LastDigit >  0  then
        if (T =  1 ) and (LastDigit in [ 1 .. 2 ]) then Sto := NumEd1[LastDigit]
        else Sto := NumEd[LastDigit];
      Money3 := Money3 div  10 ;
      Digit := Money3 mod  10 ;
      if Digit >  0  then Sto := NumDec[Digit] + Sto;
      Money3 := Money3 div  10 ;
    end;
    if Money3 >  0  then Sto := NumSot[Money3] + Sto;
    if T >  0  then begin
      if LastDigit =  1  then Sto := Sto + Xlion1[T]
      else if LastDigit in [ 2 .. 4 ] then Sto := Sto + Xlion2[T]
      else Sto := Sto + Xlion0[T];
    end;
    T := T +  1 ;
    Result := Sto + Result;
  end;
  Kop := IntToStr(MoneyK mod  10 );
  MoneyK := MoneyK div  10 ;
  Kop := IntToStr(MoneyK) + Kop;
  Result := Result + 'руб. ' + Kop + ' коп.';
end;
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
Сумма прописью
    #39800977
ZardoZ
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гугл привел к этой древней теме. Последняя реализация работает, но в ней есть ошибка. Нужно проверять, что у нас все 0 в текущем порядке. Иначе получите, например, не миллион рублей, а миллион тысяч рублей.

Код: pascal
1.
2.
3.
4.
5.
 while MoneyI > 0 do
  begin
    Money3 := MoneyI mod 1000;
    StartMod := Money3;   //добавить
    MoneyI := MoneyI div 1000;



...

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
    if T > 0 then
    begin
      if LastDigit = 1 then
        Sto := Sto + Xlion1[T]
      else
      if LastDigit in [2..4] then
        Sto := Sto + Xlion2[T]
      else
      if StartMod > 0 then  //добавить
        Sto := Sto + Xlion0[T];
    end;
...
Рейтинг: 0 / 0
Сумма прописью
    #39801065
Foxpc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Есть такая реализация
Код: pascal
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.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
program Project1;

{$APPTYPE CONSOLE}
{$R *.res}
uses
  System.SysUtils;

const
  NfFull = 0; // Полное название триад:  тысяча, миллион, ...
  NfShort = 4; // Краткое название триад:  тыс., млн., ...

  NfMale = 0; // Мужской род
  NfFemale = 1; // Женский род
  NfMiddle = 2; // Средний род

function G_NumToStr(N: Int64; var S: string; FormatFlags: LongWord): Integer;
  function ModDiv10(var V: LongWord): Integer;
  begin
    Result := V mod 10;
    V := V div 10;
  end;

const
  M_Ed: array [1 .. 9] of string = ('один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ',
    'восемь ', 'девять ');
  W_Ed: array [1 .. 9] of string = ('одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ',
    'восемь ', 'девять ');
  G_Ed: array [1 .. 9] of string = ('одно ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ',
    'восемь ', 'девять ');
  E_Ds: array [0 .. 9] of string = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ',
    'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ',
    'девятнадцать ');
  D_Ds: array [2 .. 9] of string = ('двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ',
    'семьдесят ', 'восемьдесят ', 'девяносто ');
  U_Hd: array [1 .. 9] of string = ('сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ',
    'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ');
  M_Tr: array [1 .. 6, 0 .. 3] of string = (('тыс. ', 'тысяча ', 'тысячи ', 'тысяч '),
    ('млн. ', 'миллион ', 'миллиона ', 'миллионов '), ('млрд. ', 'миллиард ', 'миллиарда ',
    'миллиардов '), ('трлн. ', 'триллион ', 'триллиона ', 'триллионов '),
    ('квадр. ', 'квадриллион ', 'квадриллиона ', 'квадриллионов '),
    ('квинт. ', 'квинтиллион ', 'квинтиллиона ', 'квинтиллионов '));
var
  V1: Int64;
  VArr: array [0 .. 6] of Integer;
  I, E, D, H, Count: Integer;
begin
  Result := 3;
  if N = 0 then
  begin
    S := 'ноль ';
    Exit;
  end;
  if N > 0 then
    S := ''
  else if N <> $8000000000000000 then
  begin
    N := -N;
    S := 'минус ';
  end else begin { -9.223.372.036.854.775.808 }
    if FormatFlags and NfShort = 0 then
      S := 'минус девять квинтиллионов двести двадцать три квадриллиона' +
        ' триста семьдесят два триллиона тридцать шесть миллиардов' +
        ' восемьсот пятьдесят четыре миллиона семьсот семьдесят пять' + ' тысяч восемьсот восемь '
    else
      S := 'минус девять квинт. двести двадцать три квадр. триста' +
        ' семьдесят два трлн. тридцать шесть млрд. восемьсот пятьдесят' +
        ' четыре млн. семьсот семьдесят пять тыс. восемьсот восемь ';
    Exit;
  end;
  Count := 0;
  repeat
    V1 := N div 1000;
    VArr[Count] := N - (V1 * 1000);
    N := V1;
    Inc(Count);
  until V1 = 0;
  for I := Count - 1 downto 0 do
  begin
    H := VArr[I];
    Result := 3;
    if H <> 0 then
    begin
      E := ModDiv10(LongWord(H));
      D := ModDiv10(LongWord(H));
      if D <> 1 then
      begin
        if E = 1 then
          Result := 1
        else if (E >= 2) and (E <= 4) then
          Result := 2;
        if (H <> 0) and (D <> 0) then
          S := S + U_Hd[H] + D_Ds[D]
        else if H <> 0 then
          S := S + U_Hd[H]
        else if D <> 0 then
          S := S + D_Ds[D];
        if E <> 0 then
          if I = 0 then
            case FormatFlags and 3 of
              0: S := S + M_Ed[E];
              1: S := S + W_Ed[E];
              2: S := S + G_Ed[E];
            else S := S + '#### ';
            end else if I = 1 then
            S := S + W_Ed[E]
          else
            S := S + M_Ed[E];
      end else if H = 0 then
        S := S + E_Ds[E]
      else
        S := S + U_Hd[H] + E_Ds[E];
      if I <> 0 then
      begin
        if FormatFlags and NfShort = 0 then
          S := S + M_Tr[I, Result]
        else
          S := S + M_Tr[I, 0];
      end;
    end;
  end;
end;

var
  Sint: Int64;
  SoutStr: string;

begin
  try
    while True do
    begin
      Readln(Sint);
      G_NumToStr(Sint, SoutStr, NfFull);
      Writeln(SoutStr);
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

end.

...
Рейтинг: 0 / 0
7 сообщений из 7, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Сумма прописью
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]