Ропись суммы в Delphi - Форум на исходниках

WWW.ИСХОДНИКИ.РУ cpp.sources.ru

java.sources.ru web.sources.ru soft.sources.ru

jdbc.sources.ru asp.sources.ru api.sources.ru

  Форум на исходниках
  Delphi
  Ропись суммы в Delphi
СПРОСИТЬ  ОТВЕТИТЬ
профайл | регистрация | faq

Автор Тема:   Ропись суммы в Delphi

VadimEdakin опубликован 24-10-2001 16:30 MSK
У кого-нибудь есть модуль для росписи суммы прописью для Delphi
Подскажите где можно поискать, плиз.
ozzy опубликован 25-10-2001 13:34 MSK
{ Преобразует трехзначное число в строку }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;interfaceusesSysUtils, StrUtils;function SumToString(Value : String) : string;implementationconst 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.

СПРОСИТЬ  ОТВЕТИТЬ
Перейти:

E-mail | WWW.ИСХОДНИКИ.RU

Powered by: Ultimate Bulletin Board, Freeware Version 5.10a
Purchase our Licensed Version- which adds many more features!
© Infopop Corporation (formerly Madrona Park, Inc.), 1998 - 2000.

Автор	Тема: Ропись суммы в Delphi
VadimEdakin	опубликован 24-10-2001 16:30 MSK У кого-нибудь есть модуль для росписи суммы прописью для Delphi Подскажите где можно поискать, плиз.
ozzy	опубликован 25-10-2001 13:34 MSK { Преобразует трехзначное число в строку }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;interfaceusesSysUtils, StrUtils;function SumToString(Value : String) : string;implementationconst 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.