Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.12.05;
Скачать: CL | DM;

Вниз

перевод чисел в числа словами   Найти похожие ветки 

 
Ivan1   (2004-11-18 21:44) [0]

когда то я давно в инете встречал такую лабуду как перевод чисел в числа словами
типа например 527 - "пятсот двадцать семь"

могет кто-то видел где?


 
begin...end ©   (2004-11-18 21:48) [1]

Нигде не видел, попробуйте сами написать.


 
Мастер ©   (2004-11-18 21:51) [2]

http://delphibase.endimus.ru/


 
Amoeba ©   (2004-11-19 11:26) [3]

Кажется на "Королевстве Дельфи" был готовый модуль.


 
Ega23 ©   (2004-11-19 11:31) [4]


const

   HN:array["0".."9"] of string[10]=
          ("","сто ","двести ","триста ","четыреста ","пятьсот ",
            "шестьсот ","семьсот ","восемьсот ","девятьсот ");
     DC:array["0".."9"] of string[13]=
          ("десять ","одиннадцать ","двенадцать ","тринадцать ",
            "четырнадцать ","пятнадцать ","шестнадцать ","семнадцать ",
            "восемнадцать ","девятнадцать ");
    KC:array["0".."9"] of string[12]=
           ("","десять ","двадцать ","тридцать ","сорок ","пятьдест ",
            "шестьдесят ","семьдесят ","восемьдесят ","девяносто ");
     RM:array["0".."9",boolean] of string[7]=
        (("",""),("один ","одна "),("два ","две "),("три ","три "),
           ("четыре ","четыре "),("пять ","пять "),("шесть ","шесть "),
           ("семь ","семь "),("восемь ","восемь "),("девять ","девять "));
     RM2:array["0".."9"] of byte=
            (0,1,2,2,2,0,0,0,0,0);
     GR:array[1..5,0..2] of string[11]=
           (("","",""),
           ("тысяч ","тысяча ","тысячи "),
           ("миллионов ","миллион ","миллиона "),
           ("миллиардов ","миллиард ","миллиарда "),
           ("триллионов ","триллион ","триллиона "));

function NumToStr(D:extended; Female:boolean):ShortString;
var S,R:ShortString;
j,k:integer;
begin
R:="";
IF (D<0)then begin R:="Возврат "; D:=D*(-1); end;
 Str(int(D):20:0,S);
S:=Trim(S);
  while length
(S) mod 3 > 0 do S:="0"+S;
for j:=length(S) div 3 downto 1 do
   begin
    k:=length(S)-3*j+1;
    if (S[k]="0") and (S[k+1]="0") and (S[k+2]="0") then continue;
    if S[k+1]="1" then R:=R+HN[S[k]]+DC[S[k+2]]+GR[j,0]
    else R:=R+HN[S[k]]+KC[S[k+1]]+RM[S[k+2],(j=2) or ((j=1) and Female)]+
            GR[j,RM2[S[k+2]]];
   end;
{дл перевода в win-кодировку}
  R[1]:=ANSIUpperCase(R[1])[1];
NumToStr:=R;
// WordCount(
end;



Вроде должно хватить.


 
Кириешки ©   (2004-11-19 11:35) [5]

У меня тоже есть. Нашел где-то. Пишешь в едите цифры, а лейбл показовает их в виде слов.

function ShortNum(num: word; razr:
integer): string;
const
 hundreds: array [0..9] of string = ("", "
сто", " двести", " триста",
   " четыреста", " пятьсот", "
шестьсот", " семьсот", " восемьсот",
   " девятьсот");
 tens: array [0..9] of string = ("", "", "
двадцать", " тридцать",
   " сорок", " пятьдесят", "
шестьдесят", " семьдесят", "
восемьдесят",
   " девяносто");
 ones: array [3..19] of string = (" три", "
четыре", " пять", " шесть",
   " семь", " восемь", " девять", "
десять", " одиннадцать",
   " двенадцать", " тринадцать", "
четырнадцать", " пятнадцать",
   " шестнадцать", " семнадцать", "
восемнадцать", " девятнадцать");
 razryad: array [0..6] of string = ("", "
тысяч", " миллион", " миллиард",
   " триллион", " квадриллион", "
квинтиллион");

var
 t: byte; // десятки
 o: byte; // единицы
begin
 result := hundreds[num div 100];
 if num mod 100 = 0 then Exit;
 t := (num mod 100) div 10;
 o := num mod 10;
 if t <> 1 then begin
   result := result + tens[t];
   case o of
     1: if razr = 1
       then result := result + " одна"
       else result := result + " один";
     2: if razr = 1
       then result := result + " две"
       else result := result + " два";
     3..9: result := result + ones[o];
   end;
   result := result + razryad[razr];
   case o of
     1: if razr = 1 then result := result +
"а";
     2..4: if razr = 1
       then result := result + "и"
       else if razr > 1 then result :=
result + "а";
     else if razr > 1 then result := result
+ "ов";
   end;
 end else begin
   result := result + ones[num mod
100];
   result := result + razryad[razr];
   if razr > 1 then result := result + "ов";
 end;
end;

function IntToWords(s: string): string;
var
 i, count: integer;
begin
 if Length(s) <= 0 then begin
   result := "ноль";
   Exit;
 end;
 count := (Length(s) + 2) div 3;
 if count > 7 then begin
   result := "Value is too large";
   Exit;
 end;
 result := "";
 s := "00" + s;
 for i := 1 to count do
   result := ShortNum(StrToInt(copy(s,
Length(s) - 3 * i + 1, 3)), i - 1) + result;
 if Length(result) > 0 then
delete(result, 1, 1);  
end;

procedure
TForm1.Button1Click(Sender:
TObject);
begin
label1.caption :=
IntToWords(Edit1.Text);
end;


 
Ega23 ©   (2004-11-19 11:37) [6]

2 Кириешки ©   (19.11.04 11:35) [5]

У меня короче.  :о)


 
Кириешки ©   (2004-11-19 11:38) [7]

Ega23 ©   (19.11.04 11:37) [6]

А у меня слов больше. :))


 
Amoeba ©   (2004-11-19 11:43) [8]

Компонент для предоставления чисел прописью
http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=1028


 
Amoeba ©   (2004-11-19 11:44) [9]

Преобразование денежной суммы в пропись
http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=805


 
Anatoly Podgoretsky ©   (2004-11-19 12:17) [10]

И в обоих слово пятсот неправильно написано


 
Bel ©   (2004-11-19 15:32) [11]

> Anatoly Podgoretsky ©   (19.11.04 12:17) [10]
> И в обоих слово пятсот неправильно написано

Анатолий, Вы не правы!


 
Кириешки ©   (2004-11-19 17:18) [12]

пятый
пять
пятьдесят
пятьсот
пятью


 
Anatoly Podgoretsky ©   (2004-11-19 17:23) [13]

Bel ©   (19.11.04 15:32) [11]
Нет я прав, привожу технические требования автора
числа словами типа например 527 - "пятсот двадцать семь"


 
Digitman ©   (2004-11-19 17:24) [14]


> встречал такую лабуду


> могет кто-то видел где?


встреча с лабудой состоялась, возрадуйся.
факт отрадный.

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



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

Текущий архив: 2004.12.05;
Скачать: CL | DM;

Наверх




Память: 0.51 MB
Время: 0.062 c
6-1096368986
Луарвик
2004-09-28 14:56
2004.12.05
TidHTTP.Request: как юзать ContentRangeStart и ContentRangeEnd


1-1101313562
Ilg
2004-11-24 19:26
2004.12.05
Variable Name Expected


1-1100774111
Vika_cc
2004-11-18 13:35
2004.12.05
frxClass.dcu


6-1092728017
Andrey
2004-08-17 11:33
2004.12.05
outlook express


1-1100784772
aglar
2004-11-18 16:32
2004.12.05
Как запустить exe файл?