число в символьную строку
On 2001-07-24 23:31, Kubik wrote:
Подскажите компонент или функцию перевода числа в символьную строку, например 123 в "сто двадцать три"
</BLOCKQUOTE></FONT></TD></TR><TR><TD><HR></TD></TR></TABLE>
хм, так её самому то написать не сложно...
// Для целого числа - кол-во цифр
kol_thifr=Edit1->Text.Length();
AnsiString propis;
if (kol_thifr==4)
// Тысячи
switch(Edit1->Text.SubString(1,1))
case 1: propis="Одна тысяча";
и т.д.
switch(Edit1->Text.SubString(2,1))
case 1: propis=propis+" сто";
и т.д.
Для десятков
if (Edit1->Text.SubString(3,1)==0)
то 1,2..8
else
11,12..19
Первый символ заглавный
if (kol_thifr==3)
// Сотни
switch(Edit1->Text.SubString(1,1))
case 1: "сто";
и т.д.
Что-бы функция была универсальна небходимо добавить сначала анализ длины числа а затем в цикле...
Взято из советов по Дэлфи Валентина Озерова
Удачи, Jaymz Void.
====================================
function TextSum(S double) string;
function Conv999(M longint; fm integer) string;
const
c1to9m array [1..9] of string [6] =
('один','два','три','четыре','пять','шесть','семь','восемь','девять');
c1to9f array [1..9] of string [6] =
('одна','две','три','четыре','пять','шесть','семь','восемь','девять');
c11to19 array [1..9] of string [12] =
('одиннадцать','двенадцать','тринадцать','четырнадцать','пятнадцать',
'шестнадцать','семнадцать','восемнадцать','девятнадцать');
c10to90 array [1..9] of string [11] =
('десять','двадцать','тридцать','сорок','пятьдесят','шестьдесят',
'семьдесят','восемьдесят','девяносто');
c100to900 array [1..9] of string [9] =
('сто','двести','триста','четыреста','пятьсот','шестьсот','семьсот',
'восемьсот','девятьсот');
var
s string;
i longint;
begin
s = '';
i = M div 100;
if i<>0 then s=c100to900+' ';
M = M mod 100;
i = M div 10;
if (M>10) and (M<20) then s=s+c11to19[M-10]+' '
else
begin
if i<>0 then s=s+c10to90+' ';
M = M mod 10;
if M<>0 then
if fm=0 then s=s+c1to9f[M]+' '
else s=s+c1to9m[M]+' ';
end;
Conv999 = s;
end;
{--------------------------------------------------------------}
var
i longint;
j longint;
r real;
t string;
begin
t = '';
j = Trunc(S/1000000000.0);
r = j;
r = S - r*1000000000.0;
i = Trunc(r);
if j<>0 then
begin
t=t+Conv999(j,1)+'миллиард';
j = j mod 100;
if (j>10) and (j<20) then t=t+'ов '
else
case j mod 10 of
0 t=t+'ов ';
1 t=t+' ';
2..4 t=t+'а ';
5..9 t=t+'ов ';
end;
end;
j = i div 1000000;
if j<>0 then
begin
t=t+Conv999(j,1)+'миллион';
j = j mod 100;
if (j>10) and (j<20) then t=t+'ов '
else
case j mod 10 of
0 t=t+'ов ';
1 t=t+' ';
2..4 t=t+'а ';
5..9 t=t+'ов ';
end;
end;
i = i mod 1000000;
j = i div 1000;
if j<>0 then
begin
t=t+Conv999(j,0)+'тысяч';
j = j mod 100;
if (j>10) and (j<20) then t=t+' '
else
case j mod 10 of
0 t=t+' ';
1 t=t+'а ';
2..4 t=t+'и ';
5..9 t=t+' ';
end;
end;
i = i mod 1000;
j = i;
if j<>0 then t=t+Conv999(j,1);
t = t+'руб. ';
i = Round(Frac(S)*100.0);
t = t+Long2Str(i)+' коп.';
TextSum = t;
end;
function TextFromValue(valueextended)string;
var IntegerPartLeninteger;
IntegerTextstring;
s1,s2,s3string;
StrAllstring[12];
Counterinteger;
st_1string;//0-999
st_2string;//1 000-999 999
st_3string;//1 000 000-999 999 999
st_4string;//1 000 000 000 - 999 999 999 999
const
Array_1array[0..9] of string =
('',' один',' два',' три',' четыре',' пять',
' шесть',' семь',' восемь',' девять');
Array_1_2array[0..9] of string =
('',' одна',' две',' три',' четыре',' пять',
' шесть',' семь',' восемь',' девять');
//...
Array_11_19array[1..9] of string =
(' одиннадцать',' двенадцать',' тринадцать',
' четырнадцать',' пятнадцать',' шестнадцать',
' семнадцать',' восемнадцать',
' девятнадцать');
//...
Array_10_90array[0..9] of string =
('',' десять',' двадцать',' тридцать',
' сорок',' пятьдесят',' шестьдесят',
' семьдесят',' восемьдесят',
' девяносто');
//...
Array_Earray[0..9] of string =
('',' сто',' двести',' триста',
' четыреста',' пятьсот',' шестьсот',
' семьсот',' восемьсот',
' девятьсот');
//................
function Return_1(var sStrstring)string;
var vvinteger;
codeinteger;
sCheckstring[2];
ccinteger;
begin
Val(sStr[1],vv,code);
s3=Array_E[vv];
//...
sCheck=Copy(sStr,2,2);
Val(sCheck,cc,code);
if cc in [11..19] then
begin
s2=Array_11_19[cc-10];
Result=s3+s2;
exit;
end else
begin
Val(sStr[2],vv,code);
s2=Array_10_90[vv];
//...
Val(sStr[3],vv,code);
s1=Array_1[vv];
//...
end;
Result=s3+s2+s1;
end;//func 1
//.......
function Return_2(var sStrstring)string;
var vvinteger;
codeinteger;
sCheckstring[2];
ccinteger;
LastWordstring;
begin
Val(sStr[1],vv,code);
s3=Array_E[vv];
//...
sCheck=Copy(sStr,2,2);
Val(sCheck,cc,code);
if cc in [11..19] then
begin
s2=Array_11_19[cc-10];
Result=s3+s2+' тысяч';
exit;
end else
begin
Val(sStr[2],vv,code);
s2=Array_10_90[vv];
//...
Val(sStr[3],vv,code);
s1=Array_1_2[vv];
//...
end;
LastWord=' тысяч';
if vv = 4 then LastWord=' тысячи';
if vv = 3 then LastWord=' тысячи';
if vv = 2 then LastWord=' тысячи';
if vv = 1 then LastWord=' тысяча';
if (s3 = '') and (s2 = '') and (s1 = '') then lastWord='';
Result=s3+s2+s1+LastWord;
end;//func 1
//.......
//.......
function Return_3(var sStrstring)string;
var vvinteger;
codeinteger;
sCheckstring[2];
ccinteger;
LastWordstring;
begin
Val(sStr[1],vv,code);
s3=Array_E[vv];
//...
sCheck=Copy(sStr,2,2);
Val(sCheck,cc,code);
if cc in [11..19] then
begin
s2=Array_11_19[cc-10];
Result=s3+s2+' миллионов';
exit;
end else
begin
Val(sStr[2],vv,code);
s2=Array_10_90[vv];
//...
Val(sStr[3],vv,code);
s1=Array_1[vv];
//...
end;
LastWord=' миллионов';
if vv = 4 then LastWord=' миллиона';
if vv = 3 then LastWord=' миллиона';
if vv = 2 then LastWord=' миллиона';
if vv = 1 then LastWord=' миллион';
if (s3 = '') and (s2 = '') and (s1 = '') then lastWord='';
Result=s3+s2+s1+LastWord;
end;//func 1
//.......
//.......
function Return_4(var sStrstring)string;
var vvinteger;
codeinteger;
sCheckstring[2];
ccinteger;
LastWordstring;
begin
Val(sStr[1],vv,code);
s3=Array_E[vv];
//...
sCheck=Copy(sStr,2,2);
Val(sCheck,cc,code);
if cc in [11..19] then
begin
s2=Array_11_19[cc-10];
Result=s3+s2+' миллиардов';
exit;
end else
begin
Val(sStr[2],vv,code);
s2=Array_10_90[vv];
//...
Val(sStr[3],vv,code);
s1=Array_1[vv];
//...
end;
LastWord=' миллиардов';
if vv = 4 then LastWord=' миллиарда';
if vv = 3 then LastWord=' миллиарда';
if vv = 2 then LastWord=' миллиарда';
if vv = 1 then LastWord=' миллиард';
if (s3 = '') and (s2 = '') and (s1 = '') then lastWord='';
Result=s3+s2+s1+LastWord;
end;//func 1
//Main function body
//.......
var Txtstring;
OneCharstring;
sstring;
begin
Result='Очень большое значение!';
if Value > 999999999999.99 then exit;
IntegerText=IntegerPart(value);
IntegerPartLen=Length(IntegerText);
StrAll='000000000000';
// Копируем строку задом наперед
for Counter=IntegerPartLen downto 1 do
begin
StrAll[(12-IntegerPartLen)+Counter]=IntegerText[Counter];
end;
//...
//Разбираем число по разрадам
st_1=Copy(StrAll,10,3);
st_2=Copy(StrAll,7,3);
st_3=Copy(StrAll,4,3);
st_4=Copy(StrAll,1,3);
//...
txt=Return_4(st_4)+Return_3(st_3)+Return_2(st_2)+Return_1(st_1);
if txt <> '' then
begin
oneChar=txt[2];
s=AnsiUpperCase(OneChar);
txt[2]=s[1];
end;
Result=txt;
end;
//................................................
function IntegerPart(valueextended)string;
var Counterinteger;
ResStrstring[1];
ValueStrstring;
rstring;
begin
Counter=1;
r='';
ValueStr=FormatFloat('0.00',value);
repeat
ResStr=ValueStr[counter];
Inc(Counter);
if (ResStr = ',') or (ResStr = '.') then break;
if ResStr = ' ' then continue;
r=r+ResStr;
until (ResStr = ',') or (ResStr = '.');
Result=r;
end;
//................................................
procedure TForm1.Button1Click(Sender: TObject);
const
e1:array [1..19] of string=('одна ','две ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять ','десять ','одиннадцать ','двенадцать ','тринадцать ','четырнадцать ','пятнадцать ','шестнадцать ','семнадцать ','восемнадцать ','девятнадцать ');
d1:array [2..9] of string=('двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто ');
s1:array [1..9] of string=('сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот ');
t1:array [0..19] of string=('тысяч ','одна тысяча ','две тысячи ','три тысячи ','четыре тысячи ','пять тысяч ','шесть тысяч ','семь тысяч ','восемь тысяч ','девять тысяч ','десять тысяч ','одиннадцать тысяч ','двенадцать тысяч ','тринадцать тысяч','четырнадцать тысяч ','пятнадцать тысяч ','шестнадцать тысяч ','семнадцать тысяч ','восемнадцать тысяч ','девятнадцать тысяч ');
d2:array [2..9] of string=('двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто ');
var
p:integer;
s:string;
begin
if IntToStr()
p:=length(Edit1.Text);
s:='';
if p=6 then s:='Сто тысяч ';
//десятки тысяч
if p=5 then begin
if (StrToInt(Edit1.Text[p-4])<>1) then begin
Case StrToInt(Edit1.Text[p-4]) mod 10 of
2:s:=s+d2[2];
3:s:=s+d2[3];
4:s:=s+d2[4];
5:s:=s+d2[5];
6:s:=s+d2[6];
7:s:=s+d2[7];
8:s:=s+d2[8];
9:s:=s+d2[9];
end;
end;
if (StrToInt(Edit1.Text[p-4])=1) then begin
Case StrToInt(Edit1.Text[p-3]) mod 10 of
0:s:=s+t1[10];
1:s:=s+t1[11];
2:s:=s+t1[12];
3:s:=s+t1[13];
4:s:=s+t1[14];
5:s:=s+t1[15];
6:s:=s+t1[16];
7:s:=s+t1[17];
8:s:=s+t1[18];
9:s:=s+t1[19];
end;
end;
end;
//Тысячи
if p=4 then begin
Case StrToInt(Edit1.Text[p-3]) mod 10 of
0:s:=s+t1[0];
1:s:=s+t1[1];
2:s:=s+t1[2];
3:s:=s+t1[3];
4:s:=s+t1[4];
5:s:=s+t1[5];
6:s:=s+t1[6];
7:s:=s+t1[7];
8:s:=s+t1[8];
9:s:=s+t1[9];
end;
end;
if p>4 then begin
if (StrToInt(Edit1.Text[p-4])<>1) then begin
Case StrToInt(Edit1.Text[p-3]) mod 10 of
0:s:=s+t1[0];
1:s:=s+t1[1];
2:s:=s+t1[2];
3:s:=s+t1[3];
4:s:=s+t1[4];
5:s:=s+t1[5];
6:s:=s+t1[6];
7:s:=s+t1[7];
8:s:=s+t1[8];
9:s:=s+t1[9];
end;
end;
end;
//Сотни
if p>2 then begin
if (StrToInt(Edit1.Text[p-2])>0) then begin
Case StrToInt(Edit1.Text[p-2]) mod 10 of
1:s:=s+s1[1];
2:s:=s+s1[2];
3:s:=s+s1[3];
4:s:=s+s1[4];
5:s:=s+s1[5];
6:s:=s+s1[6];
7:s:=s+s1[7];
8:s:=s+s1[8];
9:s:=s+s1[9];
end;
end;
end;
//Десятки
if p>1 then begin
if (StrToInt(Edit1.Text[p-1])<>1) then begin
Case StrToInt(Edit1.Text[p-1]) mod 10 of
2:s:=s+d1[2];
3:s:=s+d1[3];
4:s:=s+d1[4];
5:s:=s+d1[5];
6:s:=s+d1[6];
7:s:=s+d1[7];
8:s:=s+d1[8];
9:s:=s+d1[9];
end;
end;
if (StrToInt(Edit1.Text[p-1])=1) then begin
Case StrToInt(Edit1.Text
) mod 10 of
0:s:=s+e1[10];
1:s:=s+e1[11];
2:s:=s+e1[12];
3:s:=s+e1[13];
4:s:=s+e1[14];
5:s:=s+e1[15];
6:s:=s+e1[16];
7:s:=s+e1[17];
8:s:=s+e1[18];
9:s:=s+e1[19];
end;
end;
end;
//еденицы
if p=1 then begin
Case StrToInt(Edit1.Text
) mod 10 of
1:s:=s+e1[1];
2:s:=s+e1[2];
3:s:=s+e1[3];
4:s:=s+e1[4];
5:s:=s+e1[5];
6:s:=s+e1[6];
7:s:=s+e1[7];
8:s:=s+e1[8];
9:s:=s+e1[9];
end;
end;
if p>1 then begin
if (StrToInt(Edit1.Text[p-1])<>1) then begin
Case StrToInt(Edit1.Text
) mod 10 of
1:s:=s+e1[1];
2:s:=s+e1[2];
3:s:=s+e1[3];
4:s:=s+e1[4];
5:s:=s+e1[5];
6:s:=s+e1[6];
7:s:=s+e1[7];
8:s:=s+e1[8];
9:s:=s+e1[9];
end;
end;
end;
if StrToInt(Edit1.Text
)=1 then s:=s+'банка пива';
if (StrToInt(Edit1.Text
)>1)and(StrToInt(Edit1.Text
)<5) then s:=s+'банки пива';
if StrToInt(Edit1.Text
)>4 then s:=s+'банок пива';
if StrToInt(Edit1.Text
)=0 then s:=s+'банок пива';
showmessage(s);
end;
работает до ста тысячь, но при желании можно дописать