السلام عليكم ورحمة الله
unit WordNum;
interface
uses SysUtils, Windows, Classes, Consts;
FUNCTION A1(VAR I:DOUBLE): STRING;
FUNCTION A2(VAR I:INTEGER;I1,I2:INTEGER): STRING;
implementation
//==============================================================================
FUNCTION A2(VAR I:INTEGER;I1,I2:INTEGER):STRING;
BEGIN
case I of
1:BEGIN
case I2 of
1:A2:='واحد';
2:A2:='عشرة';
3:A2:='مائة';
4:A2:='الف';
5:A2:='عشرة آلاف';
6:A2:='مائة الف';
20:
case I1 of
1:A2:='احدى عشر';
2:A2:='اثنى عشر';
3:A2:='ثلاثة عشر';
4:A2:='اربعة عشر';
5:A2:='خمسة عشر';
6:A2:='ستة عشر';
7:A2:='سبعة عشر';
8:A2:='ثمانية عشر';
9:A2:='تسعة عشر';
end;
END;
END;
2: case I2 of
1:A2:='اثنين';
2:A2:='عشرون';
3:A2:='مائتان';
4:A2:='الفان';
5:A2:='عشرون آلاف';
6:A2:='مائتي آلف';
end;
3: case I2 of
1:A2:='ثلاثة';
2:A2:='ثلاثون';
3:A2:='ثلاثمائة';
4:A2:='ثلاثة آلاف';
5:A2:='ثلاثون آلاف';
6:A2:='ثلاثمائة آلف';
end;
4: case I2 of
1:A2:='اربعة';
2:A2:='اربعون';
3:A2:='اربعمائة';
4:A2:='اربعة آلاف';
5:A2:='اربعون آلاف';
6:A2:='اربعمائة آلف ';
end;
5: case I2 of
1:A2:='خمسة';
2:A2:='خمسون';
3:A2:='خمسمائة';
4:A2:='خمسة آلاف';
5:A2:='خمسون آلاف';
6:A2:='خمسمائة آلف ';
end;
6:case I2 of
1:A2:='ست';
2:A2:='ستون';
3:A2:='ستمائة';
4:A2:='ستة آلاف';
5:A2:='ستون آلاف';
6:A2:='ستمائة آلف ';
end;
7:case I2 of
1:A2:='سبع';
2:A2:='سبعون';
3:A2:='سبعمائة';
4:A2:='سبعة آلاف';
5:A2:='سبعون آلاف';
6:A2:='سبعمائة آلف ';
end;
8:case I2 of
1:A2:='ثمانية';
2:A2:='ثمانون';
3:A2:='ثمانمائة';
4:A2:='ثمانية آلاف';
5:A2:='ثمانون آلاف';
6:A2:='ثمانمائة آلف ';
end;
9:case I2 of
1:A2:='تسعة';
2:A2:='تسعون';
3:A2:='تسعمائة';
4:A2:='تسعة آلاف';
5:A2:='تسعون آلاف';
6:A2:='تسعمائة آلف ';
end;
END;
end;
//-----------------------------------------------------------------------------
FUNCTION A1(VAR I:DOUBLE):STRING;
VAR
S,S1,ED2:STRING;
INT2:DOUBLE;
FLAG1,INT3,INT4,INT5,INT6,INT7,INT8,INT9,INT10,INT11,INT12,INT13,INT14:INTEGER;
BEGIN
INT2:=TRUNC(I);
S1:=FLOATTOSTR(((I)-TRUNC(I))*1000);
STR((((I)-TRUNC(I))*1000):1:0,S1);
INT4:=TRUNC(I);
INT3:=STRTOINT(S1);
//INT5:=ABS(I);
FLAG1:=1;
IF (INT4<>0) THEN
case INT4 of
1..9:BEGIN
S:=A2(INT4,1,1)
END;
10..99:BEGIN
IF (INT4>=11) AND (INT4<=19) THEN
BEGIN
ED2:=inttostr(int4);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
S:=A2(INT5,INT6,20);
END
ELSE
BEGIN
ED2:=inttostr(int4);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
S:=A2(INT5,11,2);
IF INT6<>0 THEN
S:=A2(INT6,11,1)+' و '+S
ELSE
S:=A2(INT5,1,2);
END;
END;
100..999: BEGIN
ED2:=inttostr(int4);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
INT7:=STRTOINT(ED2[3]);
IF (INT6=1)AND(INT7<>0) THEN
S:=A2(INT6,INT7,20)
ELSE
BEGIN
IF INT6<>0 THEN
S:=' و '+A2(INT6,11,2);
IF (INT7<>0) THEN
// IF INT6<>0 THEN
S:=A2(INT7,11,1)+S
ELSE
S:=A2(INT6,1,2);
END;
IF (INT6=0)AND(INT7=0) THEN
S:=A2(INT5,11,3)
ELSE
S:=A2(INT5,11,3)+' و '+S;
END;
1000..9999:BEGIN
ED2:=inttostr(int4);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
INT7:=STRTOINT(ED2[3]);
INT8:=STRTOINT(ED2[4]);
IF (INT7=1)AND(INT8<>0) THEN
S:=A2(INT7,INT8,20)
ELSE
BEGIN
IF INT7<>0 THEN
S:=' و '+A2(INT7,11,2);
IF INT8<>0 THEN
S:=A2(INT8,11,1)+S
ELSE
S:=A2(INT7,1,2);//+' '+S;
END;
IF INT6<>0 THEN
S:=A2(INT6,11,3)+' و '+S;
IF (INT6=0)AND(INT7=0)AND(INT8=0) THEN
S:=A2(INT5,11,4)
ELSE
S:=A2(INT5,11,4)+' و '+S;
END;
10000..99999:BEGIN
ED2:=inttostr(int4);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
INT7:=STRTOINT(ED2[3]);
INT8:=STRTOINT(ED2[4]);
INT9:=STRTOINT(ED2[5]);
IF (INT6=0)AND (INT7=0)AND (INT8=0)AND (INT9=0) THEN
BEGIN
S:=A2(INT5,11,2)+' الف'+S;
A1:=S;
EXIT;
END;
IF (INT6=0)AND(INT7<>0)AND (INT8=0)AND (INT9=0) THEN
BEGIN
S:=A2(INT7,11,3)+S;
S:=A2(INT5,11,2)+' الف'+' و '+S;
A1:=S;
EXIT;
END;
IF (INT6=0)AND(INT7<>0)AND (INT8<>0)AND (INT9=0) THEN
BEGIN
S:=A2(INT8,11,2);
S:=A2(INT7,11,3)+' و '+S;
S:=A2(INT5,11,2)+' الف'+' و '+S;
A1:=S;
EXIT;
END;
IF (INT6=0)AND(INT7=0)AND (INT8=0)AND (INT9<>0) THEN
BEGIN
S:=A2(INT9,11,1);
S:=A2(INT5,11,2)+' الف'+' و '+S;
A1:=S;
EXIT;
END;
IF (INT6=0)AND(INT7=0)AND (INT8<>0)AND (INT9<>0) THEN
BEGIN
IF (INT8=1)AND(INT9<>0) THEN
S:=A2(INT8,INT9,20);
S:=A2(INT9,11,1)+s;
S:=A2(INT5,11,2)+' الف'+' و '+S;
A1:=S;
EXIT;
END;
{ IF (INT6<>0)AND(INT7=0)AND (INT8<>0)AND (INT9<>0) THEN
BEGIN
IF (INT8=1)AND(INT9<>0) THEN
S:=A2(INT8,INT9,20);
S:=A2(INT9,11,1)+s;
S:=A2(INT5,11,2)+' الف'+' و '+S;
S:=A2(INT6,11,1)+' و '+S ;
A1:=S;
EXIT;
END;
IF (INT6<>0)AND(INT7=0)AND (INT8<>0)AND (INT9<>0) THEN
BEGIN
IF (INT8=1)AND(INT9<>0) THEN
S:=A2(INT8,INT9,20);
S:=A2(INT9,11,1);
S:=A2(INT5,1,2)+' الف'+' و '+S;
S:=A2(INT6,11,1)+' و '+S ;
A1:=S;
EXIT;
END;
}
IF (INT5=1)AND(INT6<>0) THEN
S:=A2(INT5,INT6,20)+' الف'+S
ELSE
BEGIN
IF (INT6=0) THEN
S:=A2(INT5,11,2)+' الف'+S
ELSE
IF INT6<>0 THEN
BEGIN
S:=A2(INT5,1,2)+' الف'+S;
S:=A2(INT6,11,1)+' و '+S ;
END;
END;
IF INT7<>0 THEN
S:=S+' و '+A2(INT7,11,3);
IF (INT8=1)AND(INT9<>0) THEN
S:=S+' و '+A2(INT8,INT9,20)
ELSE
BEGIN
IF INT9<>0 THEN
S:=S+' و '+A2(INT9,11,1) ;
IF INT8<>0 THEN
S:=S+' و '+A2(INT8,11,2);
// ELSE
// IF INT8<>0 THEN
// S:=S+' و '+A2(INT8,1,2);//+' '+S;
END;
END;
100000..999999:BEGIN
ED2:=inttostr(int4);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
INT7:=STRTOINT(ED2[3]);
INT8:=STRTOINT(ED2[4]);
INT9:=STRTOINT(ED2[5]);
INT10:=STRTOINT(ED2[6]);
IF (INT6=0)AND (INT7=0)AND (INT8=0)AND (INT9=0)AND (INT10=0) THEN
BEGIN
S:=A2(INT5,11,6);
A1:=S;
EXIT;
END;
S:=A2(INT5,11,3);
IF (INT6=1)AND(INT7<>0) THEN
S:=S+' و '+A2(INT6,INT7,20)
ELSE
BEGIN
IF (INT7=0) THEN
BEGIN
IF INT6<>0 THEN
S:=S+' و '+A2(INT6,11,2);
END
ELSE
BEGIN
IF INT7<>0 THEN
S:=S+' و '+A2(INT7,11,1) ;
if INT6<>0 then
S:= S+' و '+A2(INT6,1,2);
END;
END;
S:= S+' الف ';
IF INT8<>0 THEN
S:=S+' و '+A2(INT8,11,3);
IF (INT9=1)AND(INT10<>0) THEN
S:=S+' و '+A2(INT9,INT10,20)
ELSE
BEGIN
IF INT10<>0 THEN
S:=S+' و '+A2(INT10,11,1) ;
IF INT9<>0 THEN
S:=S+' و '+A2(INT9,11,2);
END;
END;
1000000..9999999:BEGIN
ED2:=inttostr(int4);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
INT7:=STRTOINT(ED2[3]);
INT8:=STRTOINT(ED2[4]);
INT9:=STRTOINT(ED2[5]);
INT10:=STRTOINT(ED2[6]);
INT11:=STRTOINT(ED2[7]);
IF INT5<>1 THEN
S:=A2(INT5,1,1);
S:=S+' '+ 'مليون';
IF INT6<>0 THEN
BEGIN
FLAG1:=2;
S:= S+' و '+A2(INT6,11,3);
END;
IF (INT7=1)AND(INT8<>0) THEN
BEGIN
FLAG1:=2;
S:=S+' و '+A2(INT7,INT8,20);
END
ELSE
BEGIN
IF (INT8=0) THEN
BEGIN
IF INT7<>0 THEN
BEGIN
FLAG1:=2;
S:=S+' و '+A2(INT7,11,2);
END
END
ELSE
BEGIN
IF INT8<>0 THEN
BEGIN
FLAG1:=2;
S:=S+' و '+A2(INT8,11,1) ;
END;
if INT7<>0 then
BEGIN
FLAG1:=2;
S:= S+' و '+A2(INT7,1,2);
END;
END;
END;
IF FLAG1=2 THEN
S:= S+' الف ';
FLAG1:=1;
IF INT9<>0 THEN
S:=S+' و '+A2(INT9,11,3);
IF (INT10=1)AND(INT11<>0) THEN
S:=S+' و '+A2(INT10,INT11,20)
ELSE
BEGIN
IF INT11<>0 THEN
S:=S+' و '+A2(INT11,11,1) ;
IF INT10<>0 THEN
S:=S+' و '+A2(INT10,11,2);
END;
END;
{ 10000000..999999999:BEGIN
ED2:=inttostr(int4);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
INT7:=STRTOINT(ED2[3]);
INT8:=STRTOINT(ED2[4]);
INT9:=STRTOINT(ED2[5]);
INT10:=STRTOINT(ED2[6]);
INT11:=STRTOINT(ED2[7]);
INT12:=STRTOINT(ED2[7]);
IF (INT6=1)AND(INT7<>0) THEN
S:=A2(INT6,INT7,20)
ELSE
BEGIN
IF INT6<>0 THEN
S:=' و '+A2(INT6,11,2);
IF (INT7<>0) THEN
// IF INT6<>0 THEN
S:=A2(INT7,11,1)+S
ELSE
S:=A2(INT6,1,2);
END;
IF (INT6=0)AND(INT7=0) THEN
S:=A2(INT5,11,3)
ELSE
S:=A2(INT5,11,3)+' و '+S;
S:=S+ 'مليون';
A1:=S;
S:=A2(INT5,11,3)+' '+S;
IF (INT6=1)AND(INT7<>0) THEN
S:=S+' و '+A2(INT6,INT7,20)
ELSE
BEGIN
IF (INT7=0) THEN
BEGIN
IF INT6<>0 THEN
S:=S+' و '+A2(INT6,11,2);
END
ELSE
BEGIN
IF INT7<>0 THEN
S:=S+' و '+A2(INT7,11,1) ;
if INT6<>0 then
S:= S+' و '+A2(INT6,1,2);
END;
END;
S:= S+' الف ';
IF INT8<>0 THEN
S:=S+' و '+A2(INT8,11,3);
IF (INT9=1)AND(INT10<>0) THEN
S:=S+' و '+A2(INT9,INT10,20)
ELSE
BEGIN
IF INT10<>0 THEN
S:=S+' و '+A2(INT10,11,1) ;
IF INT9<>0 THEN
S:=S+' و '+A2(INT9,11,2);
END;
END; }
end;
IF (INT4<>0) THEN
S:=S+ ' دينار ';
S1:='';
IF (INT3<>0) THEN
case INT3 of
{ 1..9:BEGIN
S1:=' '+A2(INT3,1,1);
END;
10..99:BEGIN
IF (INT3>=11) AND (INT3<=19) THEN
BEGIN
ED2:=inttostr(int3);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
S1:=A2(INT5,INT6,20)+' و '+S1;
END
ELSE
BEGIN
ED2:=inttostr(int3);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
S1:=A2(INT5,11,2)+' '+S1;
IF INT6<>0 THEN
S1:=A2(INT6,11,1)+' و '+S1
ELSE
S1:=A2(INT5,1,2)+' '+S1;
END;
END;
100..999: BEGIN
ED2:=inttostr(int3);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
INT7:=STRTOINT(ED2[3]);
IF (INT6=1)AND(INT7<>0) THEN
S1:=A2(INT6,INT7,20)+' '+S1
ELSE
BEGIN
IF INT6<>0 THEN
S1:=' و '+A2(INT6,11,2)+S1;
IF (INT7<>0) THEN
// IF INT6<>0 THEN
S1:=A2(INT7,11,1)+' '+S1
ELSE
S1:=A2(INT6,1,2)+' '+S1;
END;
IF (INT6=0)AND(INT7=0) THEN
S1:=A2(INT5,11,3)+' '+S1
ELSE
S1:=A2(INT5,11,3)+' و '+S1;
END;
END;}
1..9:BEGIN
S1:=A2(INT3,1,1)
END;
10..99:BEGIN
IF (INT3>=11) AND (INT3<=19) THEN
BEGIN
ED2:=inttostr(int3);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
S1:=A2(INT5,INT6,20);
END
ELSE
BEGIN
ED2:=inttostr(int3);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
S1:=A2(INT5,11,2);
IF INT6<>0 THEN
S1:=A2(INT6,11,1)+' و '+S1
ELSE
S1:=A2(INT5,1,2);
END;
END;
100..999: BEGIN
ED2:=inttostr(int3);
INT5:=STRTOINT(ED2[1]);
INT6:=STRTOINT(ED2[2]);
INT7:=STRTOINT(ED2[3]);
IF (INT6=1)AND(INT7<>0) THEN
S1:=A2(INT6,INT7,20)
ELSE
BEGIN
IF INT6<>0 THEN
S1:=' و '+A2(INT6,11,2);
IF (INT7<>0) THEN
// IF INT6<>0 THEN
S1:=A2(INT7,11,1)+S1
ELSE
S1:=A2(INT6,1,2);
END;
IF (INT6=0)AND(INT7=0) THEN
S1:=A2(INT5,11,3)
ELSE
S1:=A2(INT5,11,3)+' و '+S1;
END;
END;
IF (INT3<>0) THEN
BEGIN
S1:=S1+' درهم ';
S:=S+' و '+S1+' فـقـط لا غـــير';
END
ELSE
S:=S+S1+' فـقـط لا غـــير';
A1:=S;
END;
//==============================================================================
end.
