Zamiana liczb na słowa

Ten program służy do zamiany liczb na tekst. Czyli po prostu pisanie słownie. Bardzo przydatny przy pisaniu dokumentów urzędowych.

-------------cut-----------------

---

*created by Łukasz *
*kslukasz@o2.pl *

---

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    SpeedButton1: TSpeedButton;
    Label1: TLabel;
    SpeedButton2: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  z:char;
implementation

{$R *.dfm}

function jedno(z:char):string;
begin
if z='1' then jedno:='jeden ' else
if z='2' then jedno:='dwa ' else
if z='3' then jedno:='trzy ' else
if z='4' then jedno:='cztery ' else
if z='5' then jedno:='pięć ' else
if z='6' then jedno:='sześć ' else
if z='7' then jedno:='siedem ' else
if z='8' then jedno:='osiem ' else
if z='9' then jedno:='dziewięć ' else
if z='0' then jedno:='' else
end;

function dz(z:char):string;
begin
if z='1' then dz:='jedenaście ' else
if z='2' then dz:='dwanaście ' else
if z='3' then dz:='trzynaście ' else
if z='4' then dz:='czternaście ' else
if z='5' then dz:='piętnaście ' else
if z='6' then dz:='szesnaście ' else
if z='7' then dz:='siedemnaście ' else
if z='8' then dz:='osiemnaście ' else
if z='9' then dz:='dziewiętnaście ' else
if z='0' then dz:='dziesięć ' else
end;

function dw(z:char):string;
begin
if z='2' then dw:='dwadzieścia ' else
if z='3' then dw:='trzydzieści ' else
if z='4' then dw:='czterdzieści ' else
if z='5' then dw:='pięćdziesiąt ' else
if z='6' then dw:='sześćdziesiąt ' else
if z='7' then dw:='siedemdziesiąt ' else
if z='8' then dw:='osiemdziesiąt ' else
if z='9' then dw:='dziewięćdziesiąt ' else
if z='0' then dw:='' else
end;

function setki(z:char):string;
begin
if z='1' then setki:='sto ' else
if z='2' then setki:='dwieście ' else
if z='3' then setki:='trzysta ' else
if z='4' then setki:='czterysta ' else
if z='5' then setki:='pięćset ' else
if z='6' then setki:='sześćset ' else
if z='7' then setki:='siedemset ' else
if z='8' then setki:='osiemset ' else
if z='9' then setki:='dziewięćset ' else
if z='0' then setki:='' else
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var i,D:integer;
    t,w:string;
    tys:string[8];
begin
tys:='tysięcy ';
memo1.Text:='';
t:=edit1.Text;
D:=Length(t);
if  D>5 then Application.MessageBox('Zbyt duża liczba! Wpisz liczbę pomiędzy 1 a 99999',' Konwerter ',MB_OK+MB_ICONERROR) else
begin
for i:=1 to D do
 begin
 if (i=D) and (t[D-1]<>'1') then
  begin
  z:=t[i];
  w:=jedno(z);
  memo1.Text:=memo1.Text+w;
  end else
  if (i=D-1) and (t[D-1]='1') then
   begin
   z:=t[D];
   w:=dz(z);
   memo1.Text:=memo1.Text+w;
   end else
   if (i=D-1) and (t[D-1]<>'1') then
    begin
    z:=t[D-1];
    w:=dw(z);
    memo1.Text:=memo1.Text+w;
    end else
    if (i=D-2) then
     begin
     z:=t[D-2];
     w:=setki(z);
     memo1.Text:=memo1.Text+w;
     end else
     if (i=D-3) and (D<5) and (t[D-4]<>'1') then
      begin
      if t[D-3]='1' then
      memo1.Text:=memo1.Text+'tysiąc ' else
      if (t[D-3]='2') or (t[D-3]='3') or (t[D-3]='4') then
      begin
      z:=t[D-3];
      w:=jedno(z);
      memo1.Text:=memo1.Text+w+'tysiące ';
      end else
      begin
      z:=t[D-3];
      w:=jedno(z);
      memo1.Text:=memo1.Text+w+tys;
      end;

      end else
      if (i=D-3) and (D>4) and (t[D-4]<>'1') then
       begin
       z:=t[D-3];
      w:=jedno(z);
      if (t[D-3]='2') or (t[D-3]='3') or (t[D-3]='4') then
      memo1.Text:=memo1.Text+w+'tysiące 'else
       memo1.Text:=memo1.Text+w+tys; 
       end else
       if (i=D-4) and(t[D-4]='1') then
        begin
        z:=t[D-3];
        w:=dz(z);
        Memo1.Text:=memo1.Text+w+tys;
        end else
        if (i=D-4) and (t[D-4]<>'1') then
         begin
         z:=t[D-4];
         w:=dw(z);
        Memo1.Text:=memo1.Text+w;
         end;
  end;
 end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Application.MessageBox('Obsługa jest bardzo prosta: wpisz liczbę w okienko na górze i odzczytaj liczbę słownie w dolnej częsci. Wpisuj TYLKO liczby, bez żadnych znaków. Wszelkie prawa zastrzeżone.',' Konwerter ',MB_OK+MB_ICONINFORMATION)
end;

end.

---------------cut---------------