Форум: "Основная";
Текущий архив: 2004.10.31;
Скачать: [xml.tar.bz2];

Вниз

Где мне найти функцию написания числа прописью, с использованием   Найти похожие ветки 

← →
Relaxxx   (2004-10-19 15:59) [0]

Где мне найти функцию написания числа прописью, с использованием дробной части

---

← →
default ©   (2004-10-19 16:17) [1]

Удалено модератором

---

← →
-=SS=- ©   (2004-10-19 16:28) [2]

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;


Может поможет :)

---

← →
Relaxxx   (2004-10-19 16:29) [3]

без дробной я уже нашол, а мне нужно именно чтобы писало целые, десятые, сотые, тысячные...

---

← →
Sandman25 ©   (2004-10-19 17:22) [4]

[3] Relaxxx   (19.10.04 16:29)

Проанализировать число знаков после запятой и написать десятых-сотых-тысячных.

---

← →
RDA   (2004-10-19 17:31) [5]


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;


Чуть переделаешь и все пучком

---

← →
Relaxxx   (2004-10-19 18:07) [6]

Да я бы не сказал что чуть-чуть переделать, тут нужно нормально повыеживаться, лучше б уже готовую функцию

---

← →
Koala ©   (2004-10-19 18:41) [7]

Relaxxx   (19.10.04 15:59)
зачем выеживатся, есть готовый компанент ASKO_DS (не помню где взял) но могу выслать на мыло
рубли и гривни с коп и без

---

← →
Relaxxx   (2004-10-20 10:41) [8]

Если не сложно вышли: Relaxxx@ua.fm

---

← →
Relaxxx   (2004-10-20 11:08) [9]

Да блин ASKO_DS это тоже не то, мне не нужна никакая валюта, мне нужно просто число с запятой писать строкой.
Например: 1234,123 -> Одна тысяча двести тридцать четыре целых сто двадцать три тысячных

Вот такого плана мне нужен вывод!!!

---

← →
msguns ©   (2004-10-20 11:37) [10]

А влом вот обратиться дважды к одной и той же проце, а потом два стринга объединить. Ну еще написать порядок дроби (простой одномерный массив)

---

← →
Relaxxx   (2004-10-20 11:59) [11]

Да чуствую что придется сетаки дописывать, я думал что найду просто быстро готовое решение!

---

← →
Sandman25 ©   (2004-10-20 12:01) [12]

Лентяи маст дай

---

← →
msguns ©   (2004-10-20 12:05) [13]

>Relaxxx   (20.10.04 11:59) [11]
>Да чуствую что придется сетаки дописывать, я думал что найду просто быстро готовое решение!

Эх, где б достать компоненту, которая б деньги печатала..

---

← →
oso   (2004-10-20 12:11) [14]

http://delphibase.endimus.ru/?action=viewfunc&topic=strconvert&id=10264

Не оно?

---

← →
Relaxxx   (2004-10-20 12:12) [15]

Проехали........

---

← →
msguns ©   (2004-10-20 12:14) [16]

>oso   (20.10.04 12:11) [14]

Ох и длиннючий же кодище ! У меня раз в несколько меньше. Хотя я внимательно не смотрел - может там еще "разнополость" учитывается.. Хотя у меня тоже это есть 8()

---

← →
Григорьев Антон ©   (2004-10-20 12:23) [17]

http://www.delphikingdom.com/asp/nets.asp?ItemID=431

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.10.31;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.035 c