إجراء التفقيط في لغة باسكال الدلفي - Function for Arabic Tafqeet

unit flyingTafqeet;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, Grids, DBGrids, StdCtrls, Mask, DBCtrls, Db, ComCtrls, Qrctrls, ExtCtrls;

   function SpellNumber(MyNumber: Real): string;
   function Horof(X: string): string;
   function SHorof(X: Real): string;
   function THorof(X: Real): string;

implementation

function SpellNumber(MyNumber: Real): string;
begin
Result := Horof(Trim(FloatToStr(MyNumber)));
end;

function Horof(X: string): string;
var
   Ma : string;
   Mi1 : string;
   Mi2 : string;
   N : LONGLONG;
   B : integer;
   R : string;
begin
Ma := ' دينار';
Mi1 := ' فلـ';
Mi2 := 'ـس';

N := Trunc(StrToFloat(X));
B := StrToInt(Copy(trim(FormatFloat('00000000000000.000',StrToFloat(X))),16,3));

R := SHorof(N);
if (R <> '') And (B > 0) Then Result := R + Ma + ' و ' + Mi1+IntToStr(B)+Mi2;
if (R <> '') And (B = 0) Then Result := R + Ma;
if (R = '') And (B <> 0) Then Result := Mi1+IntToStr(B)+Mi2;
Horof := Result;
end;

function SHorof(X: Real): string;
var
   N : LONGLONG;
   C : string;
   C1 : integer;
   C2 : integer;
   C3 : integer;
   C4 : integer;
   C5 : integer;
   C6 : integer;
   C7 : integer;
   Letter1 : string;
   Letter2 : string;
   Letter3 : string;
   Letter4 : string;
   Letter5 : string;
   Letter6 : string;
   Letter7 : string;
begin
N := Trunc(X);
C := Copy(format('%14d',[N]),1,14);
while Pos(' ', C) > 0 do
    C[Pos(' ', C)] := '0';
C1 := StrToInt(Copy(C, 14, 1));
case C1 of
1: Letter1 := 'واحد';
2: Letter1 := 'اثنان';
3: Letter1 := 'ثلاثة';
4: Letter1 := 'اربعة';
5: Letter1 := 'خمسة';
6: Letter1 := 'ستة';
7: Letter1 := 'سبعة';
8: Letter1 := 'ثمانة';
9: Letter1 := 'تسعة';
end;

C2 := StrToInt(Copy(C, 13, 1));
case C2 of
1: Letter2 := 'عشر';
2: Letter2 := 'عشرون';
3: Letter2 := 'ثلاثون';
4: Letter2 := 'اربعون';
5: Letter2 := 'خمسون';
6: Letter2 := 'ستون';
7: Letter2 := 'سبعون';
8: Letter2 := 'ثمانون';
9: Letter2 := 'تسعون';
end;

if (Letter1 <> '') And (C2 > 1) Then Letter2 := Letter1 + ' و' + Letter2;
if Letter2 = '' Then Letter2 := Letter1;
if (C1 = 0) And (C2 = 1) Then Letter2 := Letter2 + 'ة';
if (C1 = 1) And (C2 = 1) Then Letter2 := 'احدى عشر';
if (C1 = 2) And (C2 = 1) Then Letter2 := 'اثنى عشر';
if (C1 > 2) And (C2 = 1) Then Letter2 := Letter1 + ' ' + Letter2;
C3 := StrToInt(Copy(C, 12, 1));
case C3 of
1: Letter3 := 'مائة';
2: Letter3 := 'مئتان';
3..9: Letter3 := Copy(THorof(C3),1, Length(THorof(C3)) - 1) + 'مائة';
end;

if (Letter3 <> '') And (Letter2 <> '') Then Letter3 := Letter3 + ' و' + Letter2;
if Letter3 = '' then Letter3 := Letter2;

C4 := StrToInt(Copy(C, 9, 3));
Case C4 of
1: Letter4 := 'الف';
2: Letter4 := 'الفان';
3..10: Letter4 := THorof(C4) + ' آلاف';
11..999: Letter4 := THorof(C4) + ' الف';
end;

if (Letter4 <> '') And (Letter3 <> '') then Letter4 := Letter4 + ' و' + Letter3;
if Letter4 = '' then Letter4 := Letter3;
C5 := strToInt(Copy(C, 6, 3));
Case C5 of
1: Letter5 := 'مليون';
2: Letter5 := 'مليونان';
3..10: Letter5 := THorof(C5) + ' ملايين';
11..999: Letter5 := THorof(C5) + ' مليون';
end;
if (Letter5 <> '') And (Letter4 <> '') Then Letter5 := Letter5 + ' و' + Letter4;
if Letter5 = '' Then Letter5 := Letter4;

C6 := StrToInt(Copy(C, 3, 3));
Case C6 of
1: Letter6 := 'مليار';
2: Letter6 := 'ملياران';
3..999: Letter6 := THorof(C6) + ' مليار';
end;
if (Letter6 <> '') And (Letter5 <> '') Then Letter6 := Letter6 + ' و' + Letter5;
if Letter6 = '' Then Letter6 := Letter5;
C7 := StrToInt(Copy(C, 1, 2));
Case C7 of
1: Letter7 := 'بليون';
2: Letter7 := 'بليونان';
3..99: Letter7 := THorof(C7) + ' بليون';
end;
if (Letter7 <> '') And (Letter6 <> '') Then Letter7 := Letter7 + ' و' + Letter6;
if Letter7 = '' Then Letter7 := Letter6;
Result := Letter7;
end;

function THorof(X: Real): string;
var
   N : Longint;
   C : string;
   C1 : integer;
   C2 : integer;
   C3 : integer;
   Letter1 : string;
   Letter2 : string;
   Letter3 : string;
begin
N := Trunc(X);
C := Copy(format('%14d',[N]),1,14);
while Pos(' ', C) > 0 do
    C[Pos(' ', C)] := '0';
C1 := StrToInt(Copy(C, 14, 1));
case C1 of
1: Letter1 := 'واحد';
2: Letter1 := 'اثنان';
3: Letter1 := 'ثلاثة';
4: Letter1 := 'اربعة';
5: Letter1 := 'خمسة';
6: Letter1 := 'ستة';
7: Letter1 := 'سبعة';
8: Letter1 := 'ثمانية';
9: Letter1 := 'تسعة';
end;

C2 := StrToInt(Copy(C, 13, 1));
case C2 of
1: Letter2 := 'عشر';
2: Letter2 := 'عشرون';
3: Letter2 := 'ثلاثون';
4: Letter2 := 'اربعون';
5: Letter2 := 'خمسون';
6: Letter2 := 'ستون';
7: Letter2 := 'سبعون';
8: Letter2 := 'ثمانون';
9: Letter2 := 'تسعون';
end;

if (Letter1 <> '') And (C2 > 1) Then Letter2 := Letter1 + ' و' + Letter2;
if Letter2 = '' Then Letter2 := Letter1;
if (C1 = 0) And (C2 = 1) Then Letter2 := Letter2 + 'ة';
if (C1 = 1) And (C2 = 1) Then Letter2 := 'احدى عشر';
if (C1 = 2) And (C2 = 1) Then Letter2 := 'اثنى عشر';
if (C1 > 2) And (C2 = 1) Then Letter2 := Letter1 + ' ' + Letter2;

C3 := StrToInt(Copy(C, 12, 1));
case C3 of
1: Letter3 := 'مائة';
2: Letter3 := 'مئتان';
3..9: Letter3 := Copy(THorof(C3),1, Length(THorof(C3)) - 1) + 'مائة';
end;

if (Letter3 <> '') And (Letter2 <> '') Then Letter3 := Letter3 + ' و' + Letter2;
if Letter3 = '' then Letter3 := Letter2;

Result := Letter3;
end;

end.