Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

число в символьную строку

1.1K
25 июля 2001 года
Kubik
1 / / 20.04.2000
Подскажите компонент или функцию перевода числа в символьную строку, например 123 в "сто двадцать три"
Аноним
<TABLE BORDER=0 ALIGN=CENTER WIDTH=85%><TR><TD>Quote:<HR></TD></TR><TR><TD><FONT SIZE=-1><BLOCKQUOTE>
On 2001-07-24 23:31, Kubik wrote:
Подскажите компонент или функцию перевода числа в символьную строку, например 123 в &quot;сто двадцать три&quot;
</BLOCKQUOTE></FONT></TD></TR><TR><TD><HR></TD></TR></TABLE>

хм, так её самому то написать не сложно...
371
30 июля 2001 года
Non_prog
193 / / 20.03.2000
К примеру

// Для целого числа - кол-во цифр
kol_thifr=Edit1->Text.Length();
AnsiString propis;

if (kol_thifr==4)
// Тысячи

switch(Edit1->Text.SubString(1,1))
case 1: propis=&quot;Одна тысяча&quot;;
и т.д.
switch(Edit1->Text.SubString(2,1))
case 1: propis=propis+&quot; сто&quot;;
и т.д.
Для десятков
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: &quot;сто&quot;;
и т.д.
634
03 августа 2001 года
Warg Silencer
5 / / 20.01.2000
Дополнение к предидущему ответу :

Что-бы функция была универсальна небходимо добавить сначала анализ длины числа а затем в цикле...
566
04 августа 2001 года
Jaymz Void
19 / / 20.01.2000
Тут у меня завалялась прога, но она деньги переводит, переделаешь...

Взято из советов по Дэлфи Валентина Озерова

Удачи, 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;
1.1K
24 сентября 2001 года
dmk777
3 / / 20.04.2000
Во, давно как то писал

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;
//................................................
7.7K
09 февраля 2006 года
realcoding
52 / / 09.02.2006
А я однажды делал программу про банки пива, вто код:
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;

работает до ста тысячь, но при желании можно дописать

Знаете кого-то, кто может ответить? Поделитесь с ним ссылкой.

Ваш ответ

Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог