Liczba na słowo

Mam taki kadzik:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
liczba: Int64;
slownie: String;
koncowka: Integer;
rzad: Integer = 0;
j: Integer = 1;
minus: Boolean = false;

const jednosci: array[0..9] of String = ('', ' jeden', ' dwa', ' trzy', ' cztery', ' piec', ' szesc', ' siedem', ' osiem', ' dziewiec');
const nascie: array[0..9] of String = (' dziesiec', ' jedenascie', ' dwanascie', ' trzynascie', ' czternascie', ' pietnascie', ' szesnascie', ' siedemnascie', ' osiemnascie', ' dziewietnascie');
const dziesiatki: array[0..9] of String = ('', ' dziesiec', ' dwadziescia', ' trzydziesci', ' czterdziesci', ' piecdziesiat', ' szescdziesiat', ' siedemdziesiat', ' osiemdziesiat', ' dziewiecdziesiat');
const setki: array[0..9] of String = ('', ' sto', ' dwiescie', ' trzysta', ' czterysta', ' piecset', ' szescset', ' siedemset', ' osiemset', ' dziewiecset');
const x: array[0..5] of String = ('', ' tys.', ' mln.', ' mld.', ' bln.', ' bld.');

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := IntToStr(liczba);

if (liczba<0) then
begin
minus:=true;
liczba:=-liczba;
end;

if (liczba=0) then slownie:='zero';

while liczba>0 do
begin
koncowka:=liczba mod 10;
liczba:=liczba div 10;
if (j=1)and((liczba mod 100 <> 0) or (liczba<100)) then slownie:=x[rzad]+slownie;
if (j=1)and(liczba mod 10 <> 1) then slownie:=jednosci[koncowka]+slownie;
if (j=1)and(liczba mod 10 = 1) then
begin
slownie:=nascie[koncowka]+slownie;
liczba:=liczba div 10;
j:=j+2;
continue;
end;
if (j=2) then slownie:=dziesiatki[koncowka]+slownie;
if (j=3) then
begin
slownie:=setki[koncowka]+slownie;
j:=0;
rzad:=rzad+1;
end;
j:=j+1;
end;

if minus then slownie:='minus '+slownie;

Edit2.Text := slownie;
end;

end.

Jak wpisze do Edit1 jakąś cyfre to zamiast mi "przetłumaczyć" wstawia mi do Edita1 0 . Dlaczego ??

// o debugerze nie słyszałeś? :-8 - ŁF

Pisałem na szybko bo musze frytki pannie zrobic zanim wroci z Angielskiego : )

procedure TMainFrm.Button5Click(Sender: TObject);
const Liczby : array [1..3,0..9] of String = ((,'jeden','dwa','trzy','cztery','pięc','szesc','siedem','osiem','dziewiec'),(,'dziesiec','dwadziescia','trzydziesci','czterdziesci','piecdzisiat','szescdziesiat','siedemdzieciat','osiemdziesiat','dziewiecdzisiat'),('','sto','dwiescie','trzysta','czterysta','piecset','szescset','siedemset','osiemset','dziewiecset'));
var Slownie : String;
i : Byte;
begin
Slownie := '';
For i := 1 to Length(Edit1.Text) do
Slownie := Slownie + ' ' + Liczby[Length(Edit1.Text)-i+1,StrToInt(Edit1.Text[i])];
Caption := Slownie;
end;

Pewnie nie jest to idealne rozwiazanie, ale w kilka minut to przyszlo mi do glowy. To jest ogolny model potem mozesz jeszcze pozamieniac 'dziesiec dwa' na 'dwanascie', i juz a tak <ort>w ogóle </ort>to wydaje mi sie ze bylo to dawniej na forum i byl calkiem dlugi watek ale glowy nie dam. Aha no i jak 0 to dac 'zero'

type long=longint;
const
      cyfry:array[2..9]of string[8]=('dwa','trzy','cztery','pięć','sześć','siedem','osiem','dziewięć');
      nastki:array[0..9]of string[14]=('dziesięć','jedenaście','dwanaście','trzynaście','czternaście',
                                         'piętnaście','szesnaście','siedemnaście','osiemnaście','dziewiętnaście');
      dziesiatki:array[2..9]of string[16]=('dwadzieścia','trzydzieści','czterdzieści','pięćdziesiąt',
                                           'sześćdziesiąt','siedemdziesiąt','osiemdziesiąt','dziewięćdziesiąt');
      setki:array[1..9]of string[11]=('sto','dzieście','trzysta','czterysta','pięćset',
                                      'sześćset','siedemset','osiemset','dziewięćset');

function slownie(l:long):string;

function konwersja(poz:byte;l:long):string;
var s,d:string;
    i:byte;
label lab;
begin
  str(l,d);
  for i:=1 to byte(d[0]) do
    s[i]:=d[byte(d[0])+1-i];
  d[0]:=^@;
  if s[0]>#3 then
    begin
      d:=d+konwersja(poz+1,l div 1000);
      case poz of
        0:case byte(s[4])-48 of
            1:if s[0]=#4
                then d:=d+'tysiąc '
                else d:=d+'tysięcy ';
        2,3,4:if(s[0]>#4)and(s[5]=#49)
                then d:=d+'tysięcy '
                else d:=d+'tysiące ';
    5,6,7,8,9:d:=d+'tysięcy '
          end;
        1:case byte(s[4])-48 of
            1:if s[0]=#4
                then d:=d+'milion '
                else d:=d+'milionów ';
        2,3,4:if(s[0]>#4)and(s[5]=#49)
                then d:=d+'milionów '
                else d:=d+'miliony ';
    5,6,7,8,9:d:=d+'milionów '
          end;
        2:case byte(s[4])-48 of
            1:if s[0]=#4
                then d:=d+'miliard '
                else d:=d+'miliardów ';
        2,3,4:if(s[0]>#4)and(s[5]=#49)
                then d:=d+'miliardów '
                else d:=d+'miliardy ';
    5,6,7,8,9:d:=d+'miliadrów '
          end
      end
    end;
  if(s[0]>#2)and(s[3]>#48)then d:=d+setki[byte(s[3])-48]+#32;
  if(s[0]>#1)and(s[2]>#49)
    then d:=d+dziesiatki[byte(s[2])-48]+#32
    else
      if s[2]=#49 then
        begin
          d:=d+nastki[byte(s[1])-48]+#32;
          goto lab
        end;
  if l<>0
    then
      begin
        if s[1]>#49
          then d:=d+cyfry[byte(s[1])-48]+#32
          else if(s[1]>#48)and(poz=0)then d:=d+'jeden '
      end
    else d:=d+'zero ';
 lab:
   if poz=0 then dec(byte(d[0]));
   konwersja:=d
end;

begin
  if l<0
    then slownie:='minus '+konwersja(0,-l)
    else slownie:=konwersja(0,l)
end;

Co kiedyś stworzyłem. Bez bilionów i biliardów ;-). Działa. Aha, dla delphi to są shortstringi.

// OT to Dryo. Piszesz, aby mieć tą przyjemność i móc później
// napisać: 'to było', 'to jest', lub jeszcze: 'włącz głąbie przeglądarkę' :>
// Fajne zrobione bije wszystko inne na głowę.

Czasem zastanawiam się, po co ja to wszystko piszę...
http://4programmers.net/view.php?id=188