Code:

{ **** UBPFD *********** by kladovka.net ****

>> Сумма и количество прописью, работа с падежами

Несколько функций для работы с строками:

function SumToString(Value : String) : string;//Сумма прописью

function KolToStrin(Value : String) : string;//Количество прописью

function padeg(s:string):string;//Склоняет фамилию имя и отчество (кому)

function padegot(s:string):string;//Склоняет фамилию имя и отчество (от кого)

function fio(s:string):string;//фамилия имя и отчество сокращенно

function longdate(s:string):string;//Длинная дата

procedure getfullfio(s:string;var fnam,lnam,onam:string);//Получить из строки фамилию имя и отчество сокращенно

Зависимости: uses SysUtils, StrUtils,Classes;

Автор: Eda, eda @ arhadm.net.ru, Архангельск

Copyright: Eda

********************************************** }

unit sumstr;

interface

uses

SysUtils, StrUtils,Classes;

var rub:byte;

function SumToString(Value : String) : string;//Сумма прописью

function KolToStrin(Value : String) : string;//Количество прописью

function padeg(s:string):string;//Склоняет фамилию имя и отчество (кому)

function padegot(s:string):string;//Склоняет фамилию имя и отчество (от кого)

function fio(s:string):string;//фамилия имя и отчество сокращенно

function longdate(s:string):string;//Длинная дата

procedure getfullfio(s:string;var fnam,lnam,onam:string);//Получить из строки фамилию имя и отчество сокращенно

implementation

const a:array[0..8,0..9] ofstring=(

('','один ','два ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '),

('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),

('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),

('тысяч ','одна тысяча ','две тысячи ','три тысячи ','четыре тысячи ','пять тысяч ','шесть тысяч ','семь тысяч ','восемь тысяч ','девять тысяч '),

('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),

('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),

('миллионов ','один миллион ','два миллиона ','три миллиона ','четыре миллиона ','пять миллионов ','шесть миллионов ','семь миллионов ','восемь миллионов ','девять миллионов '),

('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),

('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '));

c:array[0..8,0..9] ofstring=(

('','одна ','две ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '),

('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),

('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),

('тысячь ','одна тысяча ','две тысячи ','три тысячи ','четыре тысячи ','пять тысяч ','шесть тысяч ','семь тысяч ','восемь тысяч ','девять тысяч '),

('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),

('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),

('миллионов ','один миллион ','два миллиона ','три миллиона ','четыре миллиона ','пять миллионов ','шесть миллионов ','семь миллионов ','восемь миллионов ','девять миллионов '),

('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),

('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '));

b:array[0..9] ofstring=

('десять ','одинадцать ','двенадцать ','тринадцать ','четырнадцать ','пятнадцать ','шестнадцать ','семнадцать ','восемнадцать ','девятнадцать ');

var pol:boolean;

function longdate(s:string):string;//Длинная дата

var

Pr: TDateTime;

Y,M,D: Word;

begin

Pr:= strtodate(s);

DecodeDate(Pr,Y,M,D);

case m of

1:s:='Января';

2:s:='Февраля';

3:s:='Марта';

4:s:='Апреля';

5:s:='Мая';

6:s:='Июня';

7:s:='Июля';

8:s:='Августа';

9:s:='Сентября';

10:s:='Октября';

11:s:='Ноября';

12:s:='Декабря';

end;

result:=inttostr(d)+' '+s+' '+inttostr(y)

end;

function SumToStrin(Value : String) : string;

var s,t:string;

p,pp,i,k:integer;

begin

s:=value;

if s='0'then t:='Ноль 'elsebegin

p:=length(s);

pp:=p;

if p>1then

if (s[p-1]='1') and (s[p]>='0') thenbegin

t:=b[strtoint(s[p])];pp:=pp-2;end;

i:=pp;

while i>0dobegin

if (i=p-3) and (p>4) then

if s[p-4]='1'thenbegin

t:=b[strtoint(s[p-3])]+'тысяч '+t;i:=i-2;end;

if (i=p-6) and (p>7) then

if s[p-7]='1'thenbegin

t:=b[strtoint(s[p-6])]+'миллионов '+t;

i:=i-2;end;

if i>0thenbegin k:=strtoint(s[i]);

t:=a[p-i,k]+t;

i:=i-1;end;

end;end;

result:=t;

end;

function kolToStrin(Value : String) : string;

var s,t:string;

p,pp,i,k:integer;

begin

s:=value;

if s='0'then t:='Ноль 'elsebegin

p:=length(s);

pp:=p;

if p>1then

if (s[p-1]='1') and (s[p]>'0') thenbegin

t:=b[strtoint(s[p])];pp:=pp-2;end;

i:=pp;

while i>0dobegin

if (i=p-3) and (p>4) then

if s[p-4]='1'thenbegin

t:=b[strtoint(s[p-3])]+'тысяча '+t;i:=i-2;end;

if (i=p-6) and (p>7) then

if s[p-7]='1'thenbegin

t:=b[strtoint(s[p-6])]+'миллионов '+t;

i:=i-2;end;

if i>0thenbegin k:=strtoint(s[i]);

t:=c[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=0then p:=pos('.',value);

if p<>0then delete(value,p,1);

if p=0thenbegin hi:=value;lo:='00';exit;end;

if p>length(value) thenbegin hi:=value;lo:='00';exit;end;

if p=1thenbegin hi:='0';lo:=value;exit;end;

begin

hi:=copy(value,1,p-1);

lo:=copy(value,p,length(value));

if length(lo)<2then lo:=lo+'0';

end;

end;

function sumtostring(value:string):string;

var hi,lo,valut,loval:string;

pr,er:integer;

begin

get2str(value,hi,lo);

if (hi='') or (lo='') thenbegin result:='';exit;end;

val(hi,pr,er);if er<>0thenbegin result:='';exit;end;

if rub=0thenbegin

if hi[length(hi)]='1'then valut:='рубль ';

if (hi[length(hi)]>='2') and (hi[length(hi)]<='4') then valut:='рубля ';

if (hi[length(hi)]='0') or (hi[length(hi)]>='5') or

((strtoint(copy(hi,length(hi)-1,2))>10) and (strtoint(copy(hi,length(hi)-1,2))<15)) then valut:='рублей ';

if (lo[length(lo)]='0') or (lo[length(lo)]>='5') then loval:=' копеек';

if lo[length(lo)]='1'then loval:=' копейка';

if (lo[length(lo)]>='2') and (lo[length(lo)]<='4') then loval:=' копейки';

end

elsebegin

if (hi[length(hi)]='0') or (hi[length(hi)]>='5') then valut:='долларов ';

if hi[length(hi)]='1'then valut:='доллар ';

if (hi[length(hi)]>='2') and (hi[length(hi)]<='4') then valut:='доллара ';

if (lo[length(lo)]='0') or (lo[length(lo)]>='5') then loval:=' центов';

if lo[length(lo)]='1'then loval:=' цент';

if (lo[length(lo)]>='2') and (lo[length(lo)]<='4') then loval:=' цента';

end;

hi:=sumtostrin(inttostr(pr))+valut;

if lo<>'00'thenbegin

val(lo,pr,er);if er<>0thenbegin result:='';exit;end;

lo:=inttostr(pr);

end;

if length(lo)<2then lo:='0'+lo;

lo:=lo+loval;

hi[1]:=AnsiUpperCase(hi[1])[1];

result:=hi+lo;

end;

function pfam(s:string):string;

begin

if (s[length(s)]='к') or(s[length(s)]='ч') and (pol=true) then s:=s+'у';

if s[length(s)]='в'then s:=s+'у';

if s[length(s)]='а'thenbegin delete(s,length(s),1);

result:=s+'ой';exit;end;

if s[length(s)]='н'then s:=s+'у';

if s[length(s)]='й'thenbegin delete(s,length(s)-1,2);

result:=s+'ому';end;

if s[length(s)]='я'thenbegin delete(s,length(s)-1,2);

result:=s+'ой';exit;end;

result:=s;

end;

function pnam(s:string):string;

begin

pol:=true;

if s[length(s)]='й'thenbegin delete(s,length(s),1);

s:=s+'ю';end;

if s[length(s)]='л'then s:=s+'у';

if s[length(s)]='р'then s:=s+'у';

if s[length(s)]='м'then s:=s+'у';

if s[length(s)]='н'then s:=s+'у';

if s[length(s)]='я'thenbegin pol:=false;delete(s,length(s),1);

s:=s+'е';end;

if s[length(s)]='а'thenbegin pol:=false;delete(s,length(s),1);

s:=s+'е';end;

result:=s;

end;

function potch(s:string):string;

begin

if s[length(s)]='а'thenbegin delete(s,length(s),1);

s:=s+'е';end;

if s[length(s)]='ч'then s:=s+'у';

result:=s;

end;

function ofam(s:string):string;

begin

if (s[length(s)]='к') or(s[length(s)]='ч') and (pol=true) then s:=s+'а';

if s[length(s)]='а'thenbegin delete(s,length(s),1);

result:=s+'ой';exit;end;

if s[length(s)]='в'then s:=s+'а';

if s[length(s)]='н'then s:=s+'а';

if s[length(s)]='й'thenbegin delete(s,length(s)-1,2);

result:=s+'ова';end;

if s[length(s)]='я'thenbegin delete(s,length(s)-1,2);

result:=s+'ой';exit;end;

result:=s;

end;

function onam(s:string):string;

begin

pol:=true;

if s[length(s)]='а'thenif s[length(s)-1]='г'then

begin pol:=false;delete(s,length(s),1);

s:=s+'и';endelse

begin pol:=false;delete(s,length(s),1);

s:=s+'ы';end;

if s[length(s)]='л'then s:=s+'а';

if s[length(s)]='р'then s:=s+'а';

if s[length(s)]='м'then s:=s+'а';

if s[length(s)]='н'then s:=s+'а';

if s[length(s)]='я'thenbegin pol:=false;delete(s,length(s),1);

s:=s+'и';end;

if s[length(s)]='й'thenbegin delete(s,length(s),1);

s:=s+'я';end;

result:=s;

end;

function ootch(s:string):string;

begin

if s[length(s)]='а'thenbegin delete(s,length(s),1);

s:=s+'ы';end;

if s[length(s)]='ч'then s:=s+'а';

result:=s;

end;

function padeg(s:string):string;

var q:tstringlist;

p:integer;

begin

if s<>''thenbegin

q:=tstringlist.Create;

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(s) elsebegin

q.Add(copy(s,1,p-1));

delete(s,1,p);

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(s) elsebegin

q.Add(copy(s,1,p-1));

delete(s,1,p);

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(s) elsebegin

q.Add(copy(s,1,p-1));

delete(s,1,p);end;

end;end;

if q.Count>1then result:=result+' '+pnam(q[1]);

if q.Count>0then result:=pfam(q[0])+result;

if q.Count>2then result:=result+' '+potch(q[2]);

q.Free;

end;

end;

function fio(s:string):string;

var q:tstringlist;

p:integer;

begin

if s<>''thenbegin

q:=tstringlist.Create;

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(s) elsebegin

q.Add(copy(s,1,p-1));

delete(s,1,p);

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(s) elsebegin

q.Add(copy(s,1,1));

delete(s,1,p);

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(copy(s,1,1)) elsebegin

q.Add(copy(s,1,1));

end;

end;end;

if q.Count>1then result:=q[0]+' '+q[1]+'.';

if q.Count>2then result:=result+q[2]+'.';

q.Free;

end;

end;

function padegot(s:string):string;

var q:tstringlist;

p:integer;

begin

if s<>''thenbegin

q:=tstringlist.Create;

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(s) elsebegin

q.Add(copy(s,1,p-1));

delete(s,1,p);

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(s) elsebegin

q.Add(copy(s,1,p-1));

delete(s,1,p);

p:=pos(' ',s);

if p=0then p:=pos('.',s);

if p=0then q.Add(s) elsebegin

q.Add(copy(s,1,p-1));

delete(s,1,p);end;

end;end;

if q.Count>1then result:=result+' '+onam(q[1]);

if q.Count>0then result:=ofam(q[0])+result;

if q.Count>2then result:=result+' '+ootch(q[2]);

q.Free;

end;

end;

procedure getfullfio(s:string;var fnam,lnam,onam:string);//Получить из строки фамилию имя и отчество сокращенно

begin

fnam:='';lnam:='';onam:='';

fnam:=copy(s,1,pos(' ',s));

delete(s,1,pos(' ',s));

lnam:=copy(s,1,pos(' ',s));

delete(s,1,pos(' ',s));

onam:=s;

end;

begin

rub:=0;

end.

Code:

s:=SumToString('123.00');