Цифры в слова

← →
Den (2003-05-03 09:14) [0]

есть у кого алгоритм перевода цифр в слова где то до миллиона

← →
Yanis (2003-05-03 10:13) [1]

Алгоритм не мой, предупреждаю сразу, за его неработоспособность я ни несу ни какой ответственности.
Простых путей решения этой проблемы не существует и приходится писать процедуру разбора числа. Задача сводится к разбору числа на триады (...1,234,567) начиная с конца, а уже в них происходит конечный разбор трехзначного числа и формирование его прописного эквивалента с учетом добавления "тысяч", "миллионов" и т.д. Единственное, необходимо помнить о роде "добавки" (одна тысяча, один миллион) и разницы написания (одна тысяча, две тысячи и пять тысяч)... ............ CONST MAX3 = 5; {Максимальное количество триад} A11: ARRAY[1..2] OF STRING[20] = ("одна ", "две "); A1: ARRAY[0..19] OF STRING [20] = ("", "один ", "два ","три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать "); A10: ARRAY[0..9] OF STRING [20] = ("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто "); A100: ARRAY[0..9] OF STRING[20]= ("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот "); {четвертым параметром является обозначение мужского или женского рода, где "0" - женский род; "1" - мужской род. Это дает возможность, например, изменяя "рубли" на "штуки" просто поменять "1" на "0" не меняя кода.} A0: ARRAY[0..MAX3-1, 0..3] OF STRING[20]= (("рубль", "рубля", "рублей", "1"), ("тысяча", "тысячи", "тысяч", "0"), ("миллион", "миллиона", "миллионов", "1"), ("миллиард", "миллиарда", "миллиардов", "1"), ("триллион", "триллиона", "триллионов", "1")); procedure TForm1.Edit1Change(Sender: TObject); VAR Value: LongInt; i100, i10, i1: Integer; V, p, n, i: Integer; begin TRY Value := StrToInt(Edit1.Text); Memo1.Clear; n := 0; {Обработка отрицательного значения и нуля} IF Value Memo1.Lines.Add("минус"); Value := -Value; END ELSE IF Value = 0 THEN Memo1.Lines.Add("ноль") ELSE Memo1.Lines.Add(""); REPEAT {Разбивка на триады с конца} V := Value MOD 1000; Value := Value DIV 1000; {Обработка} IF (V > 0) OR (n = 0) THEN BEGIN i100 := V DIV 100; V := V-(i100*100); IF V >= 20 THEN BEGIN i1 := V MOD 10; V := V DIV 10; i10 := V MOD 10; END ELSE BEGIN i1 := V; i10 := 0; END; CASE i1 OF 1: p := 0; 2..4: p := 1; ELSE p := 2; END; {Изменение в зависимости от женского или мужского рода} IF (A0[n,3] = "0") AND ((i1 = 1) OR (i1 = 2)) THEN Memo1.Lines.Insert(1, A100[i100]+A10[i10]+A11[i1]+A0[n,p]) ELSE Memo1.Lines.Insert(1, A100[i100]+A10[i10]+A1[i1]+A0[n,p]); END; Inc(n); {Проверка выхода за максимальное количество триад} IF n > MAX3 THEN Exit; UNTIL Value EXCEPT Memo1.Clear; Memo1.Lines.Add("Ошибка"); END end;

Если нужно разберёшся.

← →
Dmk (2003-05-03 14:19) [2]

Я тоже писал когда-то.
//.............................

function TextFromValue(value:extended):string;
var IntegerPartLen:integer;
IntegerText:string;
s1,s2,s3:string;
StrAll:string[12];
Counter:integer;
st_1:string;//0-999
st_2:string;//1 000-999 999
st_3:string;//1 000 000-999 999 999
st_4:string;//1 000 000 000 - 999 999 999 999

const
Array_1:array[0..9] of string =
("","

← →
Dmk (2003-05-03 14:20) [3]

//Продолжение ...

function Return_3(var sStr:string):string;
var vv:integer;
code:integer;
sCheck:string[2];
cc:integer;
LastWord:string;
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+"

← →
dolmat (2003-05-03 16:39) [4]

unit psum;

interface
uses
SysUtils;{,
Classes;{ }
function propis(x:real): string;
implementation
function propis(x:real): string;
var i,j:integer;s:string; r:real;
tetr:array[1..6]of string[3]; cisl:array[1..3]of string[1];
begin
for i:=1 to 6 do tetr[i]:="000";
r:=int(x);
s:=floattostr(r);
i:=length(s);
i:=i mod 3;
if i=1 then s:="00"+s
else if i=2 then s:="0"+s;
j:=round(length(s)/3);
for i:=1 to j do begin
tetr[i]:=copy(s,length(s)-2,3);
delete(s,length(s)-2,3);
end;
s:="";
repeat
cisl[1]:=copy(tetr[j],1,1);
cisl[2]:=copy(tetr[j],2,1);
cisl[3]:=copy(tetr[j],3,1);

if cisl[1]<>"0" then case strtoint(cisl[1]) of
1:s:=s+"сто ";
2:s:=s+"двести ";
3:s:=s+"триста ";
4:s:=s+"четыреста ";
5:s:=s+"пятьсот ";
6:s:=s+"шестьсот ";
7:s:=s+"семьсот ";
8:s:=s+"восемьсот ";
9:s:=s+"девятьсот ";
end;

if cisl[2]<>"0" then case strtoint(cisl[2]) of
1:begin
case strtoint(cisl[3]) of
1:s:=s+"одинадцать ";
2:s:=s+"двенадцать ";
3:s:=s+"тринадцать ";
4:s:=s+"четырнадцать ";
5:s:=s+"пятнадцать ";
6:s:=s+"шестнадцать ";
7:s:=s+"семнадцать ";
8:s:=s+"восемнадцать ";
9:s:=s+"девятнадцать ";
0:s:=s+"десять ";
end;
end;
2:s:=s+"двадцать ";
3:s:=s+"тридцать ";
4:s:=s+"сорок ";
5:s:=s+"пятьдесят ";
6:s:=s+"шестьдесят ";
7:s:=s+"семьдесят ";
8:s:=s+"восемьдесят ";
9:s:=s+"девяносто ";
end;

if (cisl[3]<>"0") and (cisl[2]<>"1") then case strtoint(cisl[3]) of
1:if j<>2 then s:=s+"один "
else s:=s+"одна ";
2:if j<>2 then s:=s+"два "
else s:=s+"две ";
3:s:=s+"три ";
4:s:=s+"четыре ";
5:s:=s+"пять ";
6:s:=s+"шесть ";
7:s:=s+"семь ";
8:s:=s+"восемь ";
9:s:=s+"девять ";
end;

if strtoint(cisl[1]+cisl[2]+cisl[3])<>0 then
case j of
2:case strtoint(cisl[3]) of
1:if strtoint(cisl[2])<>1 then s:=s+"тысяча "
else s:=s+"тысяч ";
2..4:if strtoint(cisl[2])<>1 then s:=s+"тысячи "
else s:=s+"тысяч ";
else s:=s+"тысяч ";
end;
3:case strtoint(cisl[3]) of
1:if strtoint(cisl[2])<>1 then s:=s+"миллион "
else s:=s+"миллионов ";
2..4:if strtoint(cisl[2])<>1 then s:=s+"миллиона "
else s:=s+"миллионов ";
else s:=s+"миллионов ";
end;
4:case strtoint(cisl[2]+cisl[3]) of
1:if strtoint(cisl[2])<>1 then s:=s+"миллиард "
else s:=s+"миллиардов ";
2..4:if strtoint(cisl[2])<>1 then s:=s+"миллиарда "
else s:=s+"миллиардов ";
else s:=s+"миллиардов ";
end;
5:case strtoint(cisl[2]+cisl[3]) of
1:if strtoint(cisl[2])<>1 then s:=s+"трилион "
else s:=s+"трилионов ";
2..4:if strtoint(cisl[2])<>1 then s:=s+"трилиона "
else s:=s+"трилионов ";
else s:=s+"трилионов ";
end;
6:case strtoint(cisl[2]+cisl[3]) of
1:s:=s+"трилиард ";
2..4:s:=s+"трилиарда ";
else s:=s+"трилиардов ";
end;
end;
j:=j-1;
until j=0;
propis:=s;
end;

end.

← →
Yanis (2003-05-03 18:01) [5]

Герой.

← →
MsGuns (2003-05-03 19:22) [6]

Ух, я тоже вставлюсь ;))))

unit _CnvDatU; interface uses Controls, SysUtils; type ADateStrUkr = record DtNumb: integer; DtMonth: string; DtYear: integer; end; Const UkrMonth_Tx: array [1..12] of string = ("січня","лютого","березня","квітня","травня", "червня","липня","серпня","вересня","жовтня","листопада","грудня"); UkrNumber_10: array[0..9] of string = ("","один","два","три","чотири","п`ять","шість","сім","вісім","дев`ять"); UkrNumber_100: array[1..9] of string = ("","двадцять","тридцять","сорок","п`ятдесят","шістдесят","сімдесят","вісімдесят","дев`яносто"); UkrNumber_1000: array[0..9] of string = ("","сто","двісті","триста","чотириста","п`ятьсот","шістьсот","сімсот","вісімсот","дев`ятсот"); UkrNumber_20: array[0..9] of string = ("десять","одинадцять","дванадцять","тринадцять","чотирнадцять","п`ятнадцять","шістнадцять","сімнадцять","вісімнадцять","дев`ятнадцять"); UkrNumber_Ezp: array[0..5] of string = ("","тисяча","мільон","мільярд","трильйон","квадрильйон"); UkrNumber_Tht: array [0..9] of string = ("","а","і","і","і","","","","",""); UkrNumber_Mln: array [0..9] of string = ("ів","","а","а","а","ів","ів","ів","ів","ів"); function Ms_ConvertDataUkr(var DateStr: ADateStrUkr; Date: TDate): string; function Ms_ConvertSummaUkr(Vl,VlD: string; VlSex: boolean; Sum: extended): string; implementation function Ms_ConvertDataUkr(var DateStr: ADateStrUkr; Date: TDate): string; // Функция конвертирования даты в строку на украинском языке с // параллельным заполнением структуры ADateStrUkr var d,m,y: word; begin result := "Error"; try result := DateToStr(Date); except exit; end; DecodeDate(Date,y,m,d); DateStr.DtNumb := d; DateStr.DtYear := y; DateStr.DtMonth := UkrMonth_Tx[m]; result := IntToStr(DateStr.DtNumb)+" "+DateStr.DtMonth+" "+IntToStr(DateStr.DtYear)+" г."; end; function Ms_ConvertSummaUkr(Vl,VlD: string; VlSex: boolean; Sum: extended): string; // Функция конвертирования суммы-числа в строку на украинском языке // Vl - название валюты, VlD - название копеек валюты, VlSex - род валюты: true-муж, false-жен var i,n,t: integer; s: string; function CompTriada(Numb: integer): string; // функция получения текстового фрагмента числа от 1 до 999 var e: integer; function ConcatString(Const AllLine, Line: string): string; // процедура присоединения к строке нового фрагмента begin result := AllLine; if Line>"" then begin if result>"" then result := result+" "; result := result+Line; end; end; begin result := ""; e := Numb mod 100; // Число в сотне (0-99) result := UkrNumber_1000[Numb div 100]; // Сотни if e<10 then result := ConcatString(result,UkrNumber_10[e]); if e in [10..19] then result := ConcatString(result,UkrNumber_20[e-10]); if e>19 then begin result := ConcatString(result,UkrNumber_100[e div 10]) ; // Десятки result := ConcatString(result,UkrNumber_10[e mod 10]) ; // Единицы end; end; begin result := ""; n := Round(Sum); // Рубли i := 0; while n>0 do // Выделение триад и их конвертация в строку begin t := n mod 1000; // Выделение числа-триады s := CompTriada(t); if s>"" then begin if (i=1) or ((i=0) and (Not VlSex)) then begin if (Length(s)>5) and (Copy(s,Length(s)-3,4)="один") then s := Copy(s,1,Length(s)-4)+"одна"; if (Length(s)>5) and (Copy(s,Length(s)-2,3)="два") then s := Copy(s,1,Length(s)-3)+"две"; end; s := s+" "+UkrNumber_Ezp[i]; if i=1 then begin if t mod 100 in [10..19] then s := Copy(s,1,Length(s)-1) else begin s := Copy(s,1,Length(s)-1)+UkrNumber_Tht[t mod 10]; end; end; if i>1 then begin if t mod 100 in [10..19] then s := s+"ів" else s := s+UkrNumber_Mln[t mod 10]; end; result := s+" "+result; end; n := n div 1000; inc(i); end; if result>"" then result := AnsiUpperCase(Copy(result,1,1))+Copy(result,2,Length(result)-1)+Vl+" "; // Обработка копеек s := IntToStr(Round(Sum*100) Mod 100); if Length(s)=1 then s := "0"+s; // nn копеек result := result+s+" "+VlD; end; end.

Цифры в слова Найти похожие ветки