السلام عليكم ورحمة الله وبركاته .
الكود التالي هو لبرنامج تفقيط (تحويل الأعداد إلى نص مكتوب).
برمجته على التيربو باسكال 7 ويمكن كتابة نفس الكود مع قليل من التعديل في
الإدخال والإخراج كي يعمل مع الديلفي .
هذا البرنامج يستطيع قراءة الأعداد حتى 2147483647 ويمكن تطويره أكثر على نفس مبدأ
الفكرة التي كتبته بها .. أي سؤال عن هذا البرنامج أنا جاهز وأي إنسان يستطيع إستعمال الكود
كما يريد ولكن كل ما أرجوه هو دعوة صالحة .
Program Tafqeet;
Var
T:Array[1..90]of String;
Nu:Array[1..10]of integer;
Temp,Di,Num:Longint;Al:Byte;
Const
H='hundred';Th='thousand';M='million';B='billion';O='only...';Z='zero';A='and';
Begin
{Loading the numbers in texts...}
T[1]:='one';T[2]:='two';T[3]:='three';T[4]:='four';T[5]:='five';T[6]:='six';
T[7]:='seven';T[8]:='eight';T[9]:='nine';T[10]:='ten';T[11]:='eleven';
T[12]:='twelve';T[13]:='thirteen';T[14]:='fourteen';T[15]:='fiveteen';
T[16]:='sixteen';T[17]:='seventeen';T[18]:='eighteen';T[19]:='nineteen';
T[20]:='twenty';T[30]:='thirty';T[40]:='fourty';T[50]:='fifty';T[60]:='sixty';
T[70]:='seventy';T[80]:='eighty';T[90]:='ninety';
{Reading the number...}
writeln('Enter a nine digits number ...');
{Setting the Constants}
Di:=1000000000;AL:=0;
{Extacting the numbers ...}
Read(Num);
If Num=0 then write(Z) else
If Num>2147483647 then write('Error : Number must be nine digits only !!!!') else
If Num<0 then write('Error : Number must be greater than zero !!!!') else
If Num<=10 then write(T[Num],' ');
Begin
Temp:=Num;
While (DI>=1)and(Temp>0) do
Begin
inc(Al);
Nu[Al]:=Temp div DI;
Temp:=Temp - Nu[Al]* Di;
DI:=DI div 10;
end;
{Billions Section ...1}
Case Nu[1] of
1:Write(T[Nu[1]],' ',B,', ');
2..9:Write(T[Nu[1]],' ',B,'s, ');
end;
{Millions Section ...2,3,4}
Case Nu[2] of
0:if (Nu[3]=0) and (Nu[4]=1) then write(T[Nu[4]],' ',M,', ') else
if (Nu[3]=0) and (Nu[4]<>0)then write(T[Nu[4]],' ',M,'s, ')else
if (Nu[3]=1)then write(T[Nu[3]*10+Nu[4]],' ',M,'s, ') else
if (Nu[3]>1) and (Nu[4]=0) then write(T[Nu[3]*10],' ',M,'s, ')else
if (Nu[3]>1) and (Nu[4]<>0)then write(T[Nu[3]*10],' ',T[Nu[4]],' ',M,'s, ');
1:write(T[Nu[2]],' ',H,' ');
2..9:write(T[Nu[2]],' ',H,'s ');
end;
if Nu[2]<>0 then
Case Nu[3] of
0:if (Nu[4]<>0) then write(a,' ',T[Nu[4]],' ',M,'s, ')else
if (Nu[4]=0) then write(M,'s, ');
1: write(a,' ',T[Nu[3]*10+Nu[4]],' ',M,'s, ');
2..9:if (Nu[3]=0) then write(a,' ',T[Nu[3]*10],' ',M,'s, ')else
if (Nu[3]<>0)then write(a,' ',T[Nu[3]*10],' ',T[Nu[4]],' ',M,'s, ');
end;
{Thousands Section ...5,6,7}
Case Nu[5] of
0:if (Nu[6]=0) and (Nu[7]=1) then write(T[Nu[7]],' ',th,', ') else
if (Nu[6]=0) and (Nu[7]<>0) then write(T[Nu[7]],' ',th,'s, ') else
if (Nu[6]=1) then write(T[Nu[6]*10+Nu[7]],' ',Th,'s, ') else
if (Nu[6]>1) and (Nu[7]=0) then write(T[Nu[6]*10],' ',Th,'s, ')else
if (Nu[6]>1) then write(T[Nu[6]*10],' ',T[Nu[7]],' ',Th,'s, ');
1:write(T[Nu[5]],' ',H,' ');
2..9:write(T[Nu[5]],' ',H,'s ');
end;
if Nu[5]<>0 then
Case Nu[6] of
0:if (Nu[7]<>0) then write(a,' ',T[Nu[7]],' ',Th,'s, ')else
if (Nu[7]=0) then write(Th,'s, ');
1: write(a,' ',T[Nu[6]*10+Nu[7]],' ',Th,'s, ');
2..9:if (Nu[7]=0) then write(a,' ',T[Nu[6]*10],' ',Th,'s, ')else
if (Nu[7]<>0)then write(a,' ',T[Nu[6]*10],' ',T[Nu[7]],' ',Th,'s, ');
end;
{Last AND Confirmation ...}
if ((Nu[1]<>0)or(Nu[2]<>0)or(Nu[3]<>0)or(Nu[4]<>0)or(Nu[5]<>0)or(Nu[6]<>0)or(Nu[7]<>0))
and((Nu[8]<>0)or(Nu[9]<>0)or(Nu[10]<>0))then
write(a,' ');
{Hundreds Section ...8,9,10}
Case Nu[8] of
0:if (Nu[9]=1) then write(T[Nu[9]*10+Nu[10]],' ') else
If(Nu[9]=0) then write(T[Nu[10]],' ') else
if (Nu[9]>1) and (Nu[10]=0) then write(T[Nu[9]*10],' ')else
if (Nu[9]>1) then write(T[Nu[9]*10],' ',T[Nu[10]],' ');
1:write(T[Nu[8]],' ',H,' ');
2..9:write(T[Nu[8]],' ',H,'s ');
end;
if Nu[8]<>0 then
Case Nu[9] of
1: write(a,' ',T[Nu[9]*10+Nu[10]],' ');
2..9:if (Nu[9]=0) then write(a,' ',T[Nu[9]*10],' ')else
if (Nu[9]<>0)then write(a,' ',T[Nu[9]*10],' ',T[Nu[10]],' ');
end;
write(O);
end;
readln;readln;
end.
{Programmed by : A.Kinan Sandouk NOVA A320}