Kodlar şu şekilde;
uses crt;
var
i,j,basamak:integer;
s,s2:longint;
rakamlar:array[0..10] of string;
rakamlar2:array[1..10] of string;
parcalar:array[1..7] of integer;
begin
clrscr;
rakamlar[0]:='';
rakamlar[1]:='bir';
rakamlar[2]:='iki';
rakamlar[3]:='uc';
rakamlar[4]:='dort';
rakamlar[5]:='bes';
rakamlar[6]:='alti';
rakamlar[7]:='yedi';
rakamlar[8]:='sekiz';
rakamlar[9]:='dokuz';
rakamlar2[1]:='on';
rakamlar2[2]:='yirmi';
rakamlar2[3]:='otuz';
rakamlar2[4]:='krk';
rakamlar2[5]:='elli';
rakamlar2[6]:='atmis';
rakamlar2[7]:='yetmis';
rakamlar2[8]:='seksen';
rakamlar2[9]:='doksan';
repeat
readln(s);
until s<1000000;
s2:=s;
basamak:=1;
while s2 div 10 >0 do begin
basamak:=basamak+1;
s2:= s2 div 10;
end;
s2:=s;
writeln('Girdiginiz sayi ',basamak, ' basamaklidir');
for i:=1 to basamak do begin
parcalar[7-i]:=s2 mod 10;
s2:= s2 div 10;
end;
if basamak>5 then begin
if parcalar[1]=1 then
write('yz')
else
write(rakamlar[parcalar[1]], ' yuz ');
end;
if basamak>4 then begin
write(rakamlar2[parcalar[2]],' ');
end;
if basamak>3 then begin
if (parcalar[3]=0) or (parcalar[3]=1) then
write( ' bin ')
else
write(rakamlar[parcalar[3]],' bin ');
end;
if (basamak>2) and (parcalar[4]<>0) then begin
if parcalar[4]=1 then
write('yuz')
else
write(rakamlar[parcalar[4]],' yuz ');
end;
if (basamak>1) and (parcalar[5]<>0) then begin
write(rakamlar2[parcalar[5]],' ');
end;
if basamak>0 then begin
write(rakamlar[parcalar[6]]);
end;
readln;
end.
kaynak: http://www.tekno-logy.com/pascal-girilen-sayinin-okunusunu-yazdirmak.html
