كيف يمكن تحويل رقم معين الى رقم مكتوب بالاحرف

وحدة التفقيط :

http://www.arabdevelopers.com/tips/index.p...tion=tip&aid=61

هي التي تقوم بذلك تلقائيا

للإستفادة . ونسخ من الموقع الرائع المذكور أعلاه :

unit StringTool;

interface

Uses SysUtils;

{
  LangID
        1: English
        2: Arabic

}
Function NumberToWord(LangID: Word; nReal, nDec: LongInt; DecSign, CurrSign: PChar): PChar; 

Function GetAraNum(MyNum: LongInt): String;
Function ConvertNum(MyNum: LongInt; Flag: Integer): String;
Procedure SetArray(MyStrNum: String);
Function GetEngNum(MyNum: LongInt): String;

implementation

Const
  Waw  = ' و ';
  EWaw = ' and ';
  Spc  = ' ';

//Arabic Words
  Ones:     Array[1..9] of String = ('واحد', 'أثنان', 'ثلاثة', 'اربعة',
                                     'خمسة', 'ستة', 'سبعة', 'ثمانية', 'تسعة');
  Special:  Array[1..2] of String = ('أحد', 'أثنا');
  Single:                  String = 'عشر';
  Tens:     Array[1..9] of String = ('عشرة', 'عشرون', 'ثلاثون', 'اربعون',
                                     'خمسون', 'ستون', 'سبعون', 'ثمانون', 'تسعون');
  Hundreds: Array[1..2] of String = ('مائه', 'مائتان');
  Thousnds: Array[1..3] of String = ('الف', 'الفان', 'الاف');
  Milions:  Array[1..3] of String = ('مليون', 'مليونان', 'ملايين');

//English Word
  EOnes:  Array[1..9] of String = ('One', 'Two', 'Three', 'Four', 'Five',
                                   'Six', 'Seven', 'Eight' ,'Nine');
  ETeens: Array[1..9] of String = ('Eleven', 'Twelve', 'Thirteen', 'Fourteen',
                                   'Fifteen', 'Sixteen', 'Seventeen', 'Eighteen' ,
                                   'Ninteen');
  ETens:  Array[1..9] of String = ('Ten', 'Twenty', 'Thirty', 'Fourty',
                                   'Fifty', 'Sixty', 'Seventy', 'Eighty' ,'Ninty');

  EHundreds = 'Hundred';
  EThousand = 'Thousand';
  EMilion   = 'Million';

var
  D: Array[1..20] of String;
  N: Array[1..20] of String;

//***********************************************************************
//                      Number to words Procedure
//***********************************************************************
Procedure SetArray(MyStrNum: String);
var
  I: Word;
begin
  For I := 1 to Length(MyStrNum) do
    D := Copy(MyStrNum, I, 1);
end;

Function ConvertNum(MyNum: LongInt; Flag: Integer): String;
begin
  case Flag of
    1: Result := Ones      [MyNum];
    2: Result := Ones      [MyNum] + Spc + Single;
    3: Result := Special   [MyNum] + Spc + Single;
    4: Result := Tens      [MyNum];
    5: Result := Hundreds  [MyNum];
    6: Result := Thousnds  [MyNum];
    7: Result := Milions   [MyNum];
  end;
end;

Function GetAraNum(MyNum: LongInt): String;
begin
  Case MyNum of
    0:          Result := '';
    1..9:       Result := ConvertNum(MyNum, 1);
    10:         Result := ConvertNum(1, 4);
    11, 12:     Result := ConvertNum(MyNum-10, 3);
    13..19:     Result := ConvertNum(MyNum-10, 2);
    20..99:     begin
      SetArray(IntToStr(MyNum));
      if D[2] = '0' then Result := ConvertNum(MyNum div 10, 4)
      else Result := ConvertNum(StrToInt(D[2]), 1) + Waw + ConvertNum(StrToInt(D[1]), 4);
    end;
    100..999:   begin
      SetArray(IntToStr(MyNum));
      if (D[1] = '1') or (D[1] = '2') then N[1] := ConvertNum(StrToInt(D[1]), 5)
      else N[1] := ConvertNum(StrToInt(D[1]), 1) + Spc + ConvertNum(1, 5);
      N[2] := GetAraNum(StrToInt(D[2] + D[3]));
      Result := N[1];
      if Length(N[2]) > 2 then Result := N[1] + Waw + N[2];
    end;
    1000..9999: begin
      SetArray(IntToStr(MyNum));
      if (D[1] = '1') or (D[1] = '2') then N[3] := ConvertNum(StrToInt(D[1]), 6)
      else N[3] := ConvertNum(StrToInt(D[1]), 1) + Spc + ConvertNum(3, 6);
      N[4] := GetAraNum(StrToInt(D[2] + D[3] + D[4]));
      Result := N[3];
      if Length(N[4]) > 2 then Result := N[3] + Waw + N[4];
    end;
  end;

  If (MyNum >= 10000) and (MyNum <= 99999) then begin
    SetArray(IntToStr(MyNum));
    if D[1] + D[2] = '10' then N[6] := Spc + ConvertNum(3, 6)
    else N[6] := Spc + ConvertNum(1, 6);
    N[5] := GetAraNum(StrToInt(D[1] + D[2])) + N[6];
    N[6] := GetAraNum(StrToInt(D[3] + D[4] + D[5]));
    Result := N[5];
    if Length(N[6]) > 2 then Result := N[5] + Waw + N[6];
  end
  else If (MyNum >= 100000) and (MyNum <= 999999) then begin
    SetArray(IntToStr(MyNum));
    N[7] := GetAraNum(StrToInt(D[1] + D[2] + D[3])) + Spc + ConvertNum(1, 6);
    N[8] := GetAraNum(StrToInt(D[4] + D[5] + D[6]));
    Result := N[7];
    if Length(N[8]) > 2 then Result := N[7] + Waw + N[8];
  end
  else If (MyNum >= 1000000) and (MyNum <= 9999999) then begin
    SetArray(IntToStr(MyNum));
    if (D[1] = '1') or (D[2] = '2') then N[9] := ConvertNum(StrToInt(D[1]), 7)
    else N[9] := ConvertNum(StrToInt(D[1]), 1) + Spc + ConvertNum(3, 7);
    N[10] := GetAraNum(StrToInt(D[2] + D[3] + D[4] + D[5] + D[6] + D[7]));
    Result := N[9];
    if Length(N[10]) > 2 then Result := N[9] + Waw + N[10];
  end
  else If (MyNum >= 10000000) and (MyNum <= 99999999) then begin
    SetArray(IntToStr(MyNum));
    if (D[1]  + D[2]= '10') then N[12] := Spc + ConvertNum(3, 7)
    else N[12] := Spc + ConvertNum(1, 7);
    N[12] := GetAraNum(StrToInt(D[1] + D[2])) + N[12];
    N[13] := GetAraNum(StrToInt(D[3] + D[4] + D[5] + D[6] + D[7] + D[8])) + N[6];
    Result := N[12];
    if Length(N[13]) > 2 then Result := N[12] + Waw + N[13];
  end
  else If (MyNum >= 100000000) and (MyNum <= 999999999) then begin
    SetArray(IntToStr(MyNum));
    N[14] := GetAraNum(StrToInt(D[1] + D[2] + D[3])) + Spc + ConvertNum(1, 7);
    N[15] := GetAraNum(StrToInt(D[4] + D[5] + D[6] + D[7] + D[8] + D[9]));
    Result := N[14];
    if Length(N[15]) > 2 then Result := N[14] + Waw + N[15];
  end
end;

Function GetEngNum(MyNum: LongInt): String;
var
  I:     Integer;
  Dummy: String;
begin
  Result := '';
  If MyNum = 0 then Exit;
  Case Length(IntToStr(MyNum)) of
    1:       Result := EOnes[MyNum];
    2:       begin
      if (MyNum >= 11) and (MyNum <= 19) then Result := ETeens[MyNum - 10]
      else begin
        SetArray(IntToStr(MyNum));
        Result := ETens[StrToInt(D[1])];
        if D[2] <> '0' then
          Result := ETens[StrToInt(D[1])] + Spc + EOnes[StrToInt(D[2])];
      end;
    end;
    3:       begin
      SetArray(IntToStr(MyNum));
      N[1] := EOnes[StrToInt(D[1])] + Spc + EHundreds;
      N[2] := GetEngNum(StrToInt(D[2] + D[3]));
      Result := N[1];
      if Length(N[2]) > 2 then Result := N[1] + Spc + N[2];
    end;
    4, 5, 6: begin
      SetArray(IntToStr(MyNum));
      Dummy := '';
      For I := 4 to Length(IntToStr(MyNum)) do
        Dummy := Dummy + D[I-3];
      N[3] := GetEngNum(StrToInt(Dummy)) + Spc + EThousand;
      Dummy := '';
      For I := Length(IntToStr(MyNum)) - 2 to Length(IntToStr(MyNum)) do
        Dummy := Dummy + D;
      N[4] := GetEngNum(StrToInt(Dummy));
      Result := N[3];
      if Length(N[4]) > 2 then Result := N[3] + Spc + N[4];
    end;
    7, 8, 9: begin
      SetArray(IntToStr(MyNum));
      Dummy := '';
      For I := 7 to Length(IntToStr(MyNum)) do
        Dummy := Dummy + D[I-6];
      N[5] := GetEngNum(StrToInt(Dummy)) + Spc + EMilion;
      Dummy := '';
      For I := Length(IntToStr(MyNum)) - 5 to Length(IntToStr(MyNum)) do
        Dummy := Dummy + D;
      N[6] := GetEngNum(StrToInt(Dummy));
      Result := N[5];
      if Length(N[6]) > 2 then Result := N[5] + Spc + N[6];
    end;
  end;
end;

Function NumberToWord(LangID: Word; nReal, nDec: LongInt; DecSign, CurrSign: PChar): PChar;
var
  Dummy: Array[0..2048] of char;
begin
  Result := '';
  If (nReal > 999999999) and (nDec > 999999999) then Exit;
  Case LangID of
    1: begin
      If (nReal > 0) and (nDec > 0) then
        StrPCopy(Dummy, GetEngNum(nReal) + Spc + StrPas(CurrSign) + EWaw + GetEngNum(nDec) + Spc + StrPas(DecSign))
      else if nReal > 0 then StrPCopy(Dummy, GetEngNum(nReal) + Spc + StrPas(CurrSign))
      else if nDec > 0 then  StrPCopy(Dummy, GetEngNum(nDec) + Spc + StrPas(DecSign));
    end;
    2: begin
      If (nReal > 0) and (nDec > 0) then
        StrPCopy(Dummy, GetAraNum(nReal) + Spc + StrPas(CurrSign) + Waw + GetAraNum(nDec) + Spc + StrPas(DecSign))
      else if nReal > 0 then StrPCopy(Dummy, GetAraNum(nReal) + Spc + StrPas(CurrSign))
      else if nDec > 0 then  StrPCopy(Dummy, GetAraNum(nDec) + Spc + StrPas(DecSign));
    end;
  end;
  Result := Dummy;
end;

end.

شكرا جزيلا مرة اخرى يااخي عروة .وجزاك الله الف خير