unit R2T;
(*******************************************************************************
********************************************************************************
********************************************************************************
***************************************************)
interface
function Num2Str(Num: LONGINT): String;
function FarsiCorrect(InputStr :String) :STring;
function ToFarsiText(Number :LONGINT) :String;
implementation
function Num2Str(Num: LONGINT): String;
var
TmpStr:String[15];
begin
if Num >= 1000000000 then
if (Num mod 1000000000) = 0 then
Num2Str := Num2Str(Num div 1000000000) + ' بيليون'
else
Num2Str := Num2Str(Num div 1000000000) + ' بيليون و ' +
Num2Str(Num mod 1000000000)
else
if Num >= 1000000 then
if (Num mod 1000000) = 0 then
Num2Str := Num2Str(Num div 1000000) + ' ميليون'
else
Num2Str := Num2Str(Num div 1000000) + ' ميليون و ' +
Num2Str(Num mod 1000000)
else
if Num >= 1000 then
if (Num mod 1000) = 0 then
Num2Str := Num2Str(Num div 1000) + ' هزار'
else
Num2Str := Num2Str(Num div 1000) + ' هزار و ' +
Num2Str(Num mod 1000)
else
if Num >= 100 then
if (Num mod 100) = 0 then
Num2Str := Num2Str(Num div 100) + 'صد'
else
Num2Str := Num2Str(Num div 100) + 'صد و ' +
Num2Str(Num mod 100)
else
case (Num div 10) of
9: if Num = 80 then
Num2Str := ' نود'
else
Num2Str := 'نود ' + Num2Str(Num mod 10);
8: if Num = 80 then
Num2Str := 'هشتاد'
else
Num2Str := 'هشتاد ' + Num2Str(Num mod 10);
7: if Num = 80 then
Num2Str := 'هفتاد'
else
Num2Str := 'هفتاد ' + Num2Str(Num mod 10);
6: if Num = 80 then
Num2Str := 'شصت'
else
Num2Str := 'شصت ' + Num2Str(Num mod 10);
5: if Num = 50 then
Num2Str := 'پنجاه'
else
Num2Str := 'پنجاه ' + Num2Str(Num mod 10);
4: if Num = 40 then
Num2Str := 'چهل'
else
Num2Str := 'چهل ' + Num2Str(Num mod 10);
3: if Num = 30 then
Num2Str := 'سي'
else
Num2Str := 'سي ' + Num2Str(Num mod 10);
2: if Num = 20 then
Num2Str := 'بيست'
else
Num2Str := 'بيست ' + Num2Str(Num mod 10);
0,1: case Num of
1: Num2Str := 'يک';
2: Num2Str := 'دو';
3: Num2Str := 'سه';
4: Num2Str := 'چهار';
5: Num2Str := 'پنج';
6: Num2Str := 'شش';
7: Num2Str := 'هفت';
8: Num2Str := 'هشت';
9: Num2Str := 'نه';
10: Num2Str := 'ده';
11: Num2Str := 'يازده';
12: Num2Str := 'دوازده';
13: Num2Str := 'سيزده';
14: Num2Str := 'چهارده';
15: Num2Str := 'پانزده';
16: Num2Str := 'شانزده';
17: Num2Str := 'هفده';
18: Num2Str := 'هجده';
19: Num2Str := 'نوزده';
end
end
end;
function FarsiCorrect(InputStr :String) :STring;
var
TempStr:String;
Index:Integer;
begin
TempStr:=InputStr;
Index:=Pos('دوصد',TempStr);
if Index <> 0 then
begin
while Index <> 0 do
begin
Delete(TempStr,Index,4);
Insert('دويست',TempStr,Index);
Index:=Pos('دوصد',TempStr);
end;
end;
Index:=Pos('سهصد',TempStr);
if Index <> 0 then
begin
while Index <> 0 do
begin
Delete(TempStr,Index,4);
Insert('سيصد',TempStr,Index);
Index:=Pos('سهصد',TempStr);
end;
end;
Index:=Pos('پنجصد',TempStr);
if Index <> 0 then
begin
while Index <> 0 do
begin
Delete(TempStr,Index,5);
Insert('پانصد',TempStr,Index);
Index:=Pos('پنجصد',TempStr);
end;
end;
FarsiCorrect:=TempStr + ' ريال';
end;
function ToFarsiText(Number :LongInt) :String;
begin
ToFarsiText:=FarsiCorrect(Num2Str(Number));
end;
end.