Programowanie w języku Delphi » Gotowce

Zapis słowny liczby

  • 2011-01-19 00:18
  • 9 komentarzy
  • 2237 odsłon
  • Oceń ten tekst jako pierwszy
Co tu dużo pisać. Oto kod zamieniający dowolną liczbę (np. 123456) na jej zapis słowny (sto dwadzieścia trzy tysiące czterysta piećdziesiąt sześć). Przydatne przy wypełnianiu przekazów pocztowych :P
function LiczbaSlownie(Liczba: Int64): string;
 
   function Slow(t: string): string;
    const
      {Nazwy grupy jedności}
      J: array ['1'..'9'] of string[20] =
         (' jeden', ' dwa', ' trzy', ' cztery', ' pięć', ' sześć', ' siedem', ' osiem', ' dziewięć');
         {Nazwy liczb z zakresu 10..19. Wyjątki w języku polskim}
      N: array [10..19] of string[20] =
         (' dziesięć', ' jedenaście', ' dwanaście', ' trzynaście', ' czternaście', ' piętnaście',
         ' szesnaście', ' siedemnaście', ' osiemnaście', ' dziewiętnaście');
      {Nazwy grupy dziesiątek}
      D: array ['0'..'9'] of string[20] = 
         ('', '', ' dwadzieścia', ' trzydzieści', ' czterdzieści', ' pięćdziesiąt', ' sześćdziesiąt',
         ' siedemdziesiąt', ' osiemdziesiąt', ' dziewięćdziesiąt');
      {Nazwy grupy setek}
      S: array ['0'..'9'] of string[20] = 
         ('', ' sto', ' dwieście', ' trzysta', ' czterysta', ' pięćset', ' sześćset', ' siedemset',
         ' osiemset', ' dziewięćset');
   begin
      Result := '';
      case t[2] of
         '1': Result := S[t[1]]+N[StrToInt(t[2]+t[3])];
         '0', '2'..'9': Result := S[t[1]]+D[t[2]]+J[t[3]];
      end;
   end;
 
const
   {Nazwy grup}
   G: array [0..7, 1..3] of string[20] =
      (('', '', ''),
      (' tysiąc', ' tysiące', ' tysięcy'),
      (' milion', ' miliony', ' milionów'),
      (' miliard', ' miliardy', ' miliardów'),
      (' bilion', ' biliony', ' bilionów'),
      (' biliard', ' biliardy', ' biliardów'),
      (' trylion', ' tryliony', ' trylionów'),
      (' tryliard', ' tryliardy', ' tryliardów')); //Tego to już raczej nie da się...
 
var
   sl, t1, t: string;
   i, k, dl: Byte;
begin
   t := IntToStr(Liczba);
   dl := Length(t);
   for i := 0 to (dl-1) div 3 do
      begin
      t1 := Copy(t, Length(t)-2, 3);
      Delete(t, Length(t)-2, 3);
 
      {Wyrównanie do 3 cyfr}
      for k := 1 to 3-Length(t1) do
         t1 := '0' + t1;
 
      {Jeżeli wszystkie 3 to 0 to nie ma po co dodawać nazwy grupy}
      if t1 = '000' then
        Continue;
 
      {Przypadek liczby pojedynczej}
      if (t1 = '001') then
         sl := Slow(t1) + G[i,1] + sl
         else
            {Liczby kończące się na 2, 3 lub 4 oprócz 12, 13 i 14. Ach ten język polski}
            if (t1[3] in ['2'..'4']) and (t1[2] <> '1') then
               sl := Slow(t1) + G[i,2] + sl
               else
                  sl := Slow(t1) + G[i,3] + sl;
      end;
   Result := Trim(sl);
end;

9 komentarzy

kempa65 2010-07-28 10:21

A teraz może funkcję działającą na odwrót ktoś by napisał? xD

Olch71 2006-06-07 20:38

Nie wiem jak pozostali ale ja wyłapałem błąd. Powyższy algorytm jest fajny jednak kiepsko tłumaczy liczbę 100 (sto). Aby działał należy uzupełnić tablicę nazw grupy jedności o brakujące zero ... o tak:
   {Nazwy grupy jedności}
    J: array ['0'..'9'] of string[20] =
('',' jeden', ' dwa', ' trzy', ' cztery', ' pięć', ' sześć', ' siedem', ' osiem', ' dziewięć');

... a ha zera wogóle nie tłumaczy

pozdrawiam
 

miner 2006-02-13 17:09

do plikow wstawie swoje, niestety tylko do 100. :)

konik 2005-11-25 14:16

Hmmm, chcialem sie do czegos takiego zabrac, ale nie wiedzialem, od czego zacząc :)

Adam.Pilorz 2003-12-13 17:04

Jak chodzi o te jedenaście, dwanaście... itp., to to wcale nie jest wyjątek w języku polskim... przyjrzyj się liczbom w języku angielskim, niemieckim, francuskim... Więcej nie znam... Do tego w języku polskim co jak co, ale liczby są dosyć proste... Dowiedz się jak się pisze np. 94 po francusku... Ogólnie w wolnym tłumaczeniu: cztery dwudziestki i dziewiętnaście... To jest dopiero język ;)

PiotrBorowski 2003-01-08 09:38

Świetne. Dzięki.
Ale na koniec wstawiłbym:
  sl := Trim(sl);
  Result := sl;
lub nawet
 Result := Trim(sl);
a wcześniej wyciąłbym spacje z tysięcy, milionów itd. Chodzi o te spacje na końcu - są niepotrzebne, bo i tak jednostki zaczynają się od spacji.

tomkiewicz 2003-01-05 21:51

Zbierałem się jakiś czas żeby takie cuś napisać a tu widzę że ktoś mnie ubiegł ;)

Drajwer 2003-01-04 09:26

przydało by sie delete(sl,1,1) przed result := sl
bo np jak dam liczbaslownie 50 to wyjdzie " pięćdziesiąt"

Deti 2003-01-04 09:25

Fajna funkcja - wreszcie ktoś ją napisał. Potem przetestuje czy działa ze wszystkimi liczbami! Pozdrawiam!