Форум: "Базы";
Текущий архив: 2003.10.16;
Скачать: [xml.tar.bz2];
Вниз
перевод цифр в их словарные значения Найти похожие ветки
← →
Алекси (2003-09-26 18:33) [0]помогите кто может: перешлите алгоритм перевода цифр в буквенные значения например : 423 = четыреста двадцать три
буду очень признателен
← →
Брат (2003-09-26 18:57) [1]function CifrToStr(Cifr:String;Pr:Integer;Padeg:Integer) : string;
{Функция возвращает прописью 1 цифры признак 3-единицы 2-десятки 1-сотни 4-11-19
Padeg - 1-нормально 2- одна, две }
var i:Integer;
begin
i:=StrToInt(Cifr);
if Pr = 1 Then
case i of
1: CifrToStr :="сто";
2: CifrToStr :="двести";
3: CifrToStr :="триста";
4: CifrToStr :="четыреста";
5: CifrToStr :="пятьсот";
6: CifrToStr :="шестьсот";
7: CifrToStr :="семьсот";
8: CifrToStr :="восемьсот";
9: CifrToStr :="девятьсот";
0: CifrToStr :="";
end
else if Pr = 2 Then
case i of
1: CifrToStr :="";
2: CifrToStr :="двадцать";
3: CifrToStr :="тридцать";
4: CifrToStr :="сорок";
5: CifrToStr :="пятьдесят";
6: CifrToStr :="шестьдесят";
7: CifrToStr :="семьдесят";
8: CifrToStr :="восемьдесят";
9: CifrToStr :="девяносто";
0: CifrToStr :="";
end
else if Pr = 3 Then
case i of
1: if Padeg =1 Then CifrToStr :="один"
else CifrToStr :="одна";
2: if Padeg =1 Then CifrToStr :="два"
else CifrToStr :="две";
3: CifrToStr :="три";
4: CifrToStr :="четыре";
5: CifrToStr :="пять";
6: CifrToStr :="шесть";
7: CifrToStr :="семь";
8: CifrToStr :="восемь";
9: CifrToStr :="девять";
0: CifrToStr :="";
end
else if Pr = 4 Then
case i of
1: CifrToStr :="одиннадцать";
2: CifrToStr :="двенадцать";
3: CifrToStr :="тринадцать";
4: CifrToStr :="четырнадцать";
5: CifrToStr :="пятнадцать";
6: CifrToStr :="шестнадцать";
7: CifrToStr :="семнадцать";
8: CifrToStr :="восемнадцать";
9: CifrToStr :="девятнадцать";
0: CifrToStr :="десять";
end;
end;
function Rasryad(K:Integer;V:String) : string;
{Функция возвращает наименование разряда в зависимости от последних 2 цифр его}
Var j:Integer;
Begin
j := StrToInt(Copy(v,Length(v),1));
if (StrToInt(Copy(v,Length(v)-1,2))> 9) And (StrToInt(Copy(v,Length(v)-1,2))< 20) Then
case K of
0: Rasryad :="";
1: Rasryad :="тысяч";
2: Rasryad :="миллионов";
3: Rasryad :="миллиардов";
4: Rasryad :="триллионов";
end
else
case K of
0: Rasryad :="";
1: case j of
1: Rasryad :="тысяча";
2..4: Rasryad :="тысячи";
else
Rasryad :="тысяч";
end;
2: case j of
1: Rasryad :="миллион";
2..4: Rasryad :="миллионa";
else
Rasryad :="миллионов";
end;
3: case j of
1: Rasryad :="миллиард";
2..4: Rasryad :="миллиарда";
else
Rasryad :="миллиардов";
end;
4: case j of
1: Rasryad :="триллион";
2..4: Rasryad :="триллиона";
else
Rasryad :="триллионов";
end;
end;
end;
function GroupToStr(Group:String;Padeg:Integer) : string;
{Функция возвращает прописью 3 цифры}
var i:Integer;
S:String;
begin
S:="";
if (StrToInt(Copy(Group,Length(Group)-1,2))> 9) And (StrToInt(Copy(Group,Length(Group)-1,2))< 20) Then
begin
if Length(Group) = 3 Then
S := S+" "+CifrToStr(Copy(Group,1,1),1,Padeg);
S := S+" "+CifrToStr(Copy(Group,Length(Group),1),4,Padeg);
end
else
for i:=1 to Length(Group) do
S := S+" "+CifrToStr(Copy(Group,i,1),i-Length(Group)+3,Padeg);
GroupToStr:=S;
end;
{Функция возвращает сумму прописью}
function RubToStr(Rubs:Currency;Rub,Kop:String) : string;
var i,j:Integer;
R,K,S:String;
begin
S := CurrToStr(Rubs);
S := Trim(S);
if Pos(",",S) = 0 Then
begin
R:= S;
K:= "00";
end
else
begin
R:= Copy(S,0,(Pos(",",S)-1));
K:= Copy(S,(Pos(",",S)+1),Length(S));
end;
S :="";
i:= 0;
j := 1;
While Length(R) >3 Do
Begin
if i = 1 Then j :=2
else j:=1;
S := GroupToStr(Copy(R,Length(R)-2,3),j) +" "+Rasryad(i,Copy(R,Length(R)-2,3))+ " " +S;
R := Copy(R,1,Length(R)-3);
i:=i+1;
end;
if i = 1 Then j :=2
else j:=1;
S := Trim( GroupToStr(R,j)+" "+Rasryad(i,R) + " " +S +" "+Rub+" "+K+" "+Kop);
S := ANSIUpperCase(Copy(S,1,1)) + Copy(S,2,Length(S)-1);
RubToStr := S;
end;
← →
Брат (2003-09-26 18:58) [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
Страницы: 1 вся ветка
Форум: "Базы";
Текущий архив: 2003.10.16;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.01 c
