| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Где мне найти функцию написания числа прописью, с использованием [D6, Win2k]
Relaxxx © (2004-10-19 15:59:00)Где мне найти функцию написания числа прописью, с использованием дробной части
Григорьев Антон (2004-10-20 12:23:00) [1]http://www.delphikingdom.com/asp/nets.asp?ItemID=431
msguns (2004-10-20 12:14:00) [2]>oso (20.10.04 12:11) [14]
Ох и длиннючий же кодище ! У меня раз в несколько меньше. Хотя я внимательно не смотрел - может там еще "разнополость" учитывается.. Хотя у меня тоже это есть 8()
Relaxxx (2004-10-20 12:12:00) [3]Проехали........
oso (2004-10-20 12:11:00) [4]http://delphibase.endimus.ru/?action=viewfunc&topic=strconvert&id=10264
Не оно?
msguns (2004-10-20 12:05:00) [5]>Relaxxx (20.10.04 11:59) [11]
>Да чуствую что придется сетаки дописывать, я думал что найду просто быстро готовое решение!
Эх, где б достать компоненту, которая б деньги печатала..
Sandman25 (2004-10-20 12:01:00) [6]Лентяи маст дай
Relaxxx (2004-10-20 11:59:00) [7]Да чуствую что придется сетаки дописывать, я думал что найду просто быстро готовое решение!
msguns (2004-10-20 11:37:00) [8]А влом вот обратиться дважды к одной и той же проце, а потом два стринга объединить. Ну еще написать порядок дроби (простой одномерный массив)
Relaxxx (2004-10-20 11:08:00) [9]Да блин ASKO_DS это тоже не то, мне не нужна никакая валюта, мне нужно просто число с запятой писать строкой.
Например: 1234,123 -> Одна тысяча двести тридцать четыре целых сто двадцать три тысячных
Вот такого плана мне нужен вывод!!!
Relaxxx (2004-10-20 10:41:00) [10]Если не сложно вышли: Relaxxx@ua.fm
Koala (2004-10-19 18:41:00) [11]Relaxxx (19.10.04 15:59)
зачем выеживатся, есть готовый компанент ASKO_DS (не помню где взял) но могу выслать на мыло
рубли и гривни с коп и без
Relaxxx (2004-10-19 18:07:00) [12]Да я бы не сказал что чуть-чуть переделать, тут нужно нормально повыеживаться, лучше б уже готовую функцию
RDA (2004-10-19 17:31:00) [13]
function Gr(Str:String;Por:Integer):String;
const
E:array [0..9] of String = ('','одна ','дві ','три ','чотири ','п`ять ','шість ','сім ','вісім ','дев`ять ');
D:array [0..9] of String = ('','десять ','двадцять ','тридцять ','сорок ','п`ятдесят ','шістдесят ','сімдесят ','вісімдесят ','дев`яносто ');
N:array [0..9] of String = ('','одинадцять ','двонадцять ','тринадцять ','чотирнадцять ','п`ятнадцять ','шістнадцять ','сімнадцять ','вісімнадцять ','дев`ятнадцять ');
S:array [0..9] of String = ('','сто ','двісті ','триста ','чотириста ','п`ятсот ','шістсот ','сімсот ','вісімсот ','дев`ятсот ');
begin
if (StrToInt(Copy(Str,2,2))>10) and (StrToInt(Copy(Str,2,2))<20) and (Str<>'000') then
begin
Result:=S[StrToInt(Copy(Str,1,1))]+N[StrToInt(Copy(Str,3,1))];
if Por=1 then Result:=Result+'мільонів ';
if Por=2 then Result:=Result+'тисяч ';
if Por=3 then Result:=Result+'гривень ';
end
else
begin
Result:=S[StrToInt(Copy(Str,1,1))]+D[StrToInt(Copy(Str,2,1))]+E[StrToInt(Copy(Str,3,1))];
if (Por=1) and (Str<>'000') then
case StrToInt(Copy(Str,3,1)) of
1:Result:=Result+'мільон ';
2,3,4:Result:=Result+'мільони ';
5,6,7,8,9,0:Result:=Result+'мільонів ';
end;
if (Por=2) and (Str<>'000') then
case StrToInt(Copy(Str,3,1)) of
1:Result:=Result+'тисяча ';
2,3,4:Result:=Result+'тисячі ';
5,6,7,8,9,0:Result:=Result+'тисяч ';
end;
if Por=3 then
case StrToInt(Copy(Str,3,1)) of
1:Result:=Result+'гривня ';
2,3,4:Result:=Result+'гривні ';
5,6,7,8,9,0:Result:=Result+'гривень ';
end;
end;
end;
function Kp(Str:String):String;
begin
if Str<>'00' then
begin
if (StrToInt(Copy(Str,1,2))>10) and (StrToInt(Copy(Str,1,2))<20) then Result:=Str+' копійок'
else
case StrToInt(Copy(Str,2,1)) of
1:Result:=Str+' копійка';
2,3,4:Result:=Str+' копійки';
5,6,7,8,9,0:Result:=Str+' копійок';
end;
end
else Result:='00 копійок'
end;
function Prop(S:Double):String;
var
Text,Suma:String;
begin
Suma:=FormatFloat('0.00',S);
if Suma<>'0,00' then
begin
try
while Length(Suma)<12 do
Suma:='0'+Suma;
if Copy(Suma,1,9)<>'000000000' then Text:=Gr(Copy(Suma,1,3),1)+Gr(Copy(Suma,4,3),2)+Gr(Copy(Suma,7,3),3)+Kp(Copy(Suma,11,2))
else Text:='Нуль гривень '+Kp(Copy(Suma,11,2));
Result:=AnsiUpperCase(Copy(Text,1,1))+Copy(Text,2,Length(Text));
except
end;
end
else Result:='Нуль гривень 00 копійок';
end;
Чуть переделаешь и все пучком
Sandman25 (2004-10-19 17:22:00) [14][3] Relaxxx (19.10.04 16:29)
Проанализировать число знаков после запятой и написать десятых-сотых-тысячных.
Relaxxx (2004-10-19 16:29:00) [15]без дробной я уже нашол, а мне нужно именно чтобы писало целые, десятые, сотые, тысячные...
-=SS=- (2004-10-19 16:28:00) [16]
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[i]+' ';
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[i]+' ';
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;
Может поможет :)
default (2004-10-19 16:17:00) [17]Удалено модератором
| |
