تحويل وحدة الى فاست ريبورت - نسخة قابلة للطباعة

كود :
unit Unit2;
// دالة التفقيط الآلي
// برمجة محمد مهند عبادي 2003

interface

uses SysUtils,StrUtils;

Function words(D : Double; F1 : String = 'واحدة'; F2 :String = 'واحدتين' ; F3 : String = 'واحدات'
; D1 : String = 'جزء' ; D2 : String = 'جزئين'; D3: String = 'أجزاء'; SayJust : Boolean = True) : String;
implementation

Function words(D : Double; F1 : String = 'واحدة'; F2 :String = 'واحدتين' ; F3 : String = 'واحدات'
; D1 : String = 'جزء' ; D2 : String = 'جزئين'; D3: String = 'أجزاء'; SayJust : Boolean = True) : String;
Var
  P,P1,P2,P3,P4,w,w1,w2,w3,N,n1 : String;
  SD : Int64;
(*------------------------------------------------------------------------*)
  Function Swords(N, U1, U2, U3 : String) : String;
  Type
    TF = array[0..2,0..9] of String;
  Const
    FNO : TF = (('','واحد','إثنان','ثلاثة','أربعة','خمسة','ستة','سبعة','ثمانية','تسعة'),
              ('','عشر','عشرون','ثلاثون','أربعون','خمسون','ستون','سبعون','ثمانون','تسعون'),
              ('','مائة','مائتين','ثلاثمائة','أربعمائة','خمسمائة','ستمائة','سبعمائة','ثمانمائة','تسعمائة'));
  Var
    s: array[1..3] of Byte;
    PU : array[0..2] of String;
    A : Tf;
    w1,w2,f : String;
    E : integer;
  Begin
    A := FNO;
    Pu[0] := '';
    PU[1] := U1 ;
    Pu[2] := U2 ;
    E := StrToInt(N);
    If E < 3 then  Swords := pu[E]
    Else
      Begin
        N := leftstr('000',3-length(n)) + N ;
        For E := 1 to 3 Do S[E] := StrToInt(n[4-E]);
        If (s[2] = 0) or (s[1] = 0) Then W2 := '' Else W2 := ' و ';
        If (s[3] = 0) Or (s[1]+S[2] = 0) Then W1 := '' Else W1 := ' و ';
        If S[2] = 1 Then
          Begin
            A[0,1] := 'أحد ';
            A[0,2] := 'إثنا ' ;
            W2 := ' ';
          End;

        Case strToInt(n[2]+n[3]) of
          0 : Begin
                A[2, 2] := 'مائتا ';
                F := U1;
              End;
          3..10 :    F := U3;
          1,2, 11..99 : F := U1;
        end;
        swords := A[2, S[3]] + w1 + A[0, S[1]] + w2 + A[1, S[2]] + ' ' + F;
      End;
  End;
(*------------------------------------------------------------------------*)
Begin
  If D > 0 Then
    Begin
      Sd := Trunc(D);
      p := Swords(inttostr(round((d-sd)*100)),D1,D2,D3);
      N := leftstr('000000000000',12-length(floattostr(Sd))) + floattostr(Sd) ;
      P1 := Swords(Copy(N, 10, 3), F1, F2, F3);
      P2 := Swords(Copy(N, 7, 3), 'ألف', 'ألفان', 'آلاف');
      P3 := Swords(copy(N, 4, 3), 'مليون', 'مليونان', 'ملايين');
      P4 := Swords(copy(N, 1, 3), 'مليار', 'ملياران', 'مليارات');
      If (P4 = '') Or (P1 + P2 + P3 = '') Then w3 := '' Else w3 := ' و ';
      If (P3 = '') Or (P1 + P2 = '') Then w2 := '' Else w2 := ' و ';
      If (P2 = '') Or (P1 = '') Then w1 := '' Else w1 := ' و ';
      If P1 = '' Then P1 := ' ' + F1;
      If P = '' Then w := '' Else w := ' و ';
      N := P4 + w3 + P3 + w2 + P2 + w1 + P1 + w + P;
      If SayJust Then words := 'فقط ' + N + ' لاغير'Else Words := N;
    end;

End;

end.