Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.12.05;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.49 MB
Время: 0.029 c
1-1100684507
Богдан
2004-11-17 12:41
2004.12.05
Заполнение полей TEdit


14-1100757653
sniknik
2004-11-18 09:00
2004.12.05
Разминка к пятнице, легкая задачка на четверг...


1-1100862998
Dolphin001
2004-11-19 14:16
2004.12.05
msEquation


1-1100966872
лена19
2004-11-20 19:07
2004.12.05
действительные типы


14-1100471215
Дип
2004-11-15 01:26
2004.12.05
Языки программирования





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский