如何将数字转成英文序数词? ex: 1 -> One, 2 -> Two, 21 -> Twenty-One, ....

Question

above

Answer 1

建立一个包含(One,Two...)的枚举类型，然后用序号取枚举名

Answer 2

TNumber=(one,two,three,four,five,six,seven,eight,nine,ten)
 var
   i:integer;   
   i=ord(one) //i=1;
   ...

Answer 3

贴一篇将数字转成中文数字的程序，也许能得到些启发，不过要转换成英文可要麻烦的多，祝你好运。unit cutils;interfaceuses
    SysUtils;function CNum2Num(sChineseNum: string; var dblArabic: double): boolean;
function Num2CNum(dblArabic: double): string;implementation(* -------------------------------------------------- *)
(* Num2CNum  将阿拉伯数字转成中文数字字串
(* 使用示例:
(*  Num2CNum(10002.34) ==> 一万零二点三四
(*
(* Author: Wolfgang Chien 
(* Date: 1996/08/04
(* Update Date:
(* -------------------------------------------------- *)
function Num2CNum(dblArabic: double): string;
const
  _ChineseNumeric = '零一二三四五六七八九';
var
  sArabic: string;
  sIntArabic: string;
  iPosOfDecimalPoint: integer;
  i: integer;
  iDigit: integer;
  iSection: integer;
  sSectionArabic: string;
  sSection: string;
  bInZero: boolean;
  bMinus: boolean;  (* 将字串反向, 例如: 传入 '1234', 传回 '4321' *)
  function ConvertStr(const sBeConvert: string): string;
  var
    x: integer;
  begin
    Result := '';
    for x := Length(sBeConvert) downto 1 do
      AppendStr(Result, sBeConvert[x]);
  end; { of ConvertStr }
begin
  Result := '';
  bInZero := True;
  sArabic := FloatToStr(dblArabic); (* 将数字转成阿拉伯数字字串 *)
  {$ifdef __Debug}
  ShowMessage('FloatToStr(dblArabic): ' + sArabic);
  {$endif}
  if sArabic[1] = '-' then
  begin
    bMinus := True;
    sArabic := Copy(sArabic, 2, 254);
  end
  else
    bMinus := False;
  iPosOfDecimalPoint := Pos('.', sArabic);  (* 取得小数点的位置 *)
  {$ifdef __Debug}
  ShowMessage('Pos(''.'', sArabic) ' + IntToStr(iPosOfDecimalPoint));
  {$endif}  (* 先处理整数的部分 *)
  if iPosOfDecimalPoint = 0 then
    sIntArabic := ConvertStr(sArabic)
  else
    sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));
  (* 从个位数起以每四位数为一小节 *)
  for iSection := 0 to ((Length(sIntArabic) - 1) div 4) do
  begin
    sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
    sSection := '';
    (* 以下的 i 控制: 个十百千位四个位数 *)
    for i := 1 to Length(sSectionArabic) do
    begin
      iDigit := Ord(sSectionArabic[i]) - 48;
      if iDigit = 0 then
      begin
        (* 1. 避免 '零' 的重覆出现 *)
        (* 2. 个位数的 0 不必转成 '零' *)
        if (not bInZero) and (i <> 1) then sSection := '零' + sSection;
        bInZero := True;
      end
      else
      begin
        case i of
          2: sSection := '十' + sSection;
          3: sSection := '百' + sSection;
          4: sSection := '千' + sSection;
        end;
        sSection := Copy(_ChineseNumeric, 2 * iDigit + 1, 2) +
          sSection;
        bInZero := False;
      end;
    end;    (* 加上该小节的位数 *)
    if Length(sSection) = 0 then
    begin
      if (Length(Result) > 0) and (Copy(Result, 1, 2) <> '零') then
        Result := '零' + Result;
    end
    else
    begin
      case iSection of
        0: Result := sSection;
        1: Result := sSection + '万' + Result;
        2: Result := sSection + '亿' + Result;
        3: Result := sSection + '兆' + Result;
      end;
    end;
    {$ifdef __Debug}
    ShowMessage('sSection: ' + sSection);
    ShowMessage('Result: ' + Result);
    {$endif}
  end;  (* 处理小数点右边的部分 *)
  if iPosOfDecimalPoint > 0 then
  begin
    AppendStr(Result, '点');
    for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
    begin
      iDigit := Ord(sArabic[i]) - 48;
      AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
    end;
  end;  {$ifdef __Debug}
  ShowMessage('Result before 其他例外处理: ' + Result);
  {$endif}
  (* 其他例外状况的处理 *)
  if Length(Result) = 0 then Result := '零';
  if Copy(Result, 1, 4) = '一十' then Result := Copy(Result, 3, 254);
  if Copy(Result, 1, 2) = '点' then Result := '零' + Result;  (* 是否为负数 *)
  if bMinus then Result := '负' + Result;
  {$ifdef __Debug}
  ShowMessage('Result before Exit: ' + Result);
  {$endif}
end;
(* -------------------------------------------------- *)
(* CNum2Num  将中文数字字串转成阿拉伯数字
(* 使用示例:
(*  if CNum2Num('一千三百万零四十点一零三', dblTest)
(*    dblTest ==> 13000040.103
(*
(* 注意事项:
(*  1. 转换成功, 函数传回 True; 否则为 False
(*  2. 不支援 '四万万' 等的说法, 必须为标准的记数方式
(*
(* Author: Wolfgang Chien 
(* Date: 1996/08/04
(* Update Date:
(* -------------------------------------------------- *)
function CNum2Num(sChineseNum: string; var dblArabic: double): boolean;
const
  _ChineseNumeric = '十百千万亿兆点零一二三四五六七八九';
  {_ChineseNumeric = '1十3百5千7万9亿11兆13点15零17一19二21三四五六七八九';}
var
  i: integer;
  iPos: integer;
  dblBuffer: double;
  sMultiChar: string;
  iDigit: integer;
  iRightOfDecimal: integer;
  bMinus: boolean;  (* 简单的十次方函数, 取 10^n, where n: byte and n >= 0 *)
  function EasyPower10(iPower: byte): double;
  var
    i: integer;
  begin
    Result := 1;
    try
      for i := 1 to iPower do Result := Result * 10;
    except
      Result := 0;
    end;
  end;
begin
  Result := False;
  dblArabic := 0;
  dblBuffer := 0;
  iDigit := -1;
  iRightOfDecimal := -1;  if Copy(sChineseNum, 1, 2) = '负' then
  begin
    sChineseNum := Copy(sChineseNum, 3, 254);
    bMinus := True;
  end
  else
    bMinus := False;  i := 1;
  while i < Length(sChineseNum) do
  begin
    (* 如果不是中文字 ==> Fail *)
    if sChineseNum[i] < #127 then Exit;
    sMultiChar := Copy(sChineseNum, i, 2);
    iPos := Pos(sMultiChar, _ChineseNumeric);
    if iPos = 0 then Exit;
    if (iDigit = -1) and (iPos > 13) then
      iDigit := (iPos - 15) div 2;
    case iPos of
      1, 3, 5:
        begin
          (* 十百千 *)
          if iDigit = -1 then iDigit := 1;
          dblBuffer := dblBuffer + iDigit * EasyPower10((iPos + 1) div 2);
          iDigit := -1;
        end;
      7, 9, 11:
        begin
          (* 万亿兆 *)
          if (iDigit > 0) and (iDigit < 10) then
            dblBuffer := dblBuffer + iDigit;
          dblArabic := dblArabic + dblBuffer * EasyPower10((iPos-5) div 2 * 4);
          iDigit := -1;
          dblBuffer := 0;
        end;
      13:
        begin
          (* 小数点 *)
          if (iDigit > 0) and (iDigit < 10) then
            dblBuffer := dblBuffer + iDigit;
          dblArabic := dblArabic + dblBuffer;
          dblBuffer := 0;
          iDigit := -1;
          iRightOfDecimal := 0;
        end;
      15:  (* 零 *)
        begin
          if iRightOfDecimal > -1 then Inc(iRightOfDecimal);
          iDigit := -1;
        end;
    else
      begin
        if iRightOfDecimal > -1 then
        begin
          (* 小数点右边的部分 *)
          Inc(iRightOfDecimal);
          try
            dblArabic := dblArabic + iDigit / EasyPower10(iRightOfDecimal);
          except
            Exit;
          end;
          iDigit := -1;
        end;
      end;
    end;    {$ifdef __Debug}
    ShowMessage(IntToStr(i) + 'th dblArabic: '  + FloatToStr(dblArabic));
    ShowMessage(IntToStr(i) + 'th dblBuffer: '  + FloatToStr(dblBuffer));
    ShowMessage(IntToStr(i) + 'th iDigit: '  + IntToStr(iDigit));
    {$endif}    Inc(i, 2);
  end;  if (iDigit > 0) and (iDigit < 10) then
    dblBuffer := dblBuffer + iDigit;
  if dblBuffer <> 0 then dblArabic := dblArabic + dblBuffer;
  if bMinus then
  begin
    {$ifdef __SafeMode}
    sChineseNum := '负' + sChineseNum;
    {$endif}
    dblArabic := dblArabic * -1;
  end;
  {$ifdef __SafeMode}
  Result := sChineseNum = Num2CNum(dblArabic);
  {$else}
  Result := True;
  {$endif}
end;end.

Answer 4

//安装这个控件
unit NumberConvert;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type  TNumberName = record
    Number: integer;
    NameMasculine,  // If it stands in front of masculine gender.
    NameFeminine    // If it stands in front of feminine gender. If empty, NameMasculine is used (meaning feminine and masculine name is the same).
    //,NameNeuter // Unused for now.
     : string;
  end;  TNumberNames = array of TNumberName;  TGender = (gMasculine,gFeminine,rNeuter);  // If Name5 or Name 2 is not set, then Name1 is used. If Name1 is not set, Name1Ignored is used.  TNumberOrder = record
    Order: integer; // Number of zeros (exponent of the number system base).
    Gender: TGender;   // Male or female (neutral is not used for now).
    Name1Ignored: string; // If prefix "one" is excluded.
    Name1: string;
    Name2: string;
    Name5: string;
  end;  TNumberOrders = array of TNumberOrder;  TNumberLanguage = (nlEnglishUS,nlEnglishBritish,nlSerbian,nlSerbianFont,nlCustom);  TNumberToText = class(TComponent)
  private
    FLanguage: TNumberLanguage;
    FSeparator: string;
    FIgnoreOne: boolean;
    FDecimalSeparator: string;
    FMinusName: string;
    FNumber: Extended;
    function GetText: string;
    procedure SetText(const Value: string);
  protected
    procedure SetLanguage(const Value: TNumberLanguage); virtual;
  public
    NumberNames: TNumberNames;
    NumberOrders: TNumberOrders;
    constructor Create(AOwner: TComponent); override;
  published
    property DecimalSeparator: string read FDecimalSeparator write FDecimalSeparator;
    property IgnoreOne: boolean read FIgnoreOne write FIgnoreOne;
    property Language: TNumberLanguage read FLanguage write SetLanguage;
    property MinusName: string read FMinusName write FMinusName;
    property Number: Extended read FNumber write FNumber;
    property Separator: string read FSeparator write FSeparator;
    property Text: string read GetText write SetText stored false;
  end;  TNumberToRoman = class(TComponent)
  private
    FNumber: Cardinal;
    function GetRomanNumber: string;
    procedure SetRomanNumber(const Value: string);
  published
    property Number: Cardinal read FNumber write FNumber;
    property RomanNumber: string read GetRomanNumber write SetRomanNumber stored false;
  end;  // TODO: RelatedComponent - automatically update Caption or Text.procedure Register;
function CardToRoman(a: Cardinal): string;
function TrimRightZeros(const x: Int64): Int64;

Answer 5

implementationuses
  Math;{$R *.dcr}procedure Register;
begin
  RegisterComponents('BConvert', [TNumberToText,TNumberToRoman]);
end;// Converts 'a' into string containing roman form of that number.
// NOTE: Special cases, when I is placed in front of some
// digits are treated separately - it's simplest.
function CardToRoman(a: Cardinal): string;
const
  br=13; // Broj cifara.
type
  oznakatip = array[0..br-1] of string;
  vrednosttip = array[0..br-1] of Cardinal;
const (* I V X L C D M *)
  oznaka: oznakatip = (    'I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M' );
  vrednost: vrednosttip = (1,  4,   5,  9,   10, 40,  50, 90,  100,400, 500,900, 1000);
var
  //cch: Cardinal; // Tekuci karakter u 'r'.
  indeks: 0..br-1;  // Vraca indeks rimske cifre koja je najveca od onih koje su manje od 'max'.
  function NajvecaManjaIliJednaka(const max: Cardinal): Cardinal;
  var
    curr: Cardinal;
  begin
    curr := Low(vrednost);
    while curr < High(vrednost) do  // Ne mora <=.
    begin
      if vrednost[curr+1] <= max then
        Inc(curr)
      else
      begin
        if vrednost[curr] <= max then
        begin
          result := curr;
          exit
        end
        else
          raise Exception.Create('NajvecaManjaIliJednaka(): ''max'' je premali.');
      end
    end;
    result := High(vrednost)
  end;begin
  result := '';
  while a > 0 do
  begin
    indeks := NajvecaManjaIliJednaka(a);
    Dec(a,vrednost[indeks]);
    result := result + oznaka[indeks];
  end
end;// Get rid of trailing zeros.
function TrimRightZeros(const x: Int64): Int64;
begin
  result := x;
  while (result <> 0) and ((result mod 10) = 0) do
    result := result div 10
end;// Internal number-to-text conversion routine.
function NumberToText(
  Brojevi: TNumberNames;
  Redovi: TNumberOrders;
  const MinusName: string;
  Broj: Int64;
  const DecimalSeparatorName: string;
  Fraction: Int64 = 0;
  FractionPos: integer = 0;
  const Separator: string = ' ';
  const ZanemariJedan: boolean = true
): string;  // Dodaje 'S1' na 'S' i umece separator izmedju (ali samo ako je potrebno).
  function AppendSepStr(const S,S1: string): string;
  begin
    result := S;
    if S1 = '' then
      exit;
    if not (S = '') then
      result := result + Separator;
    result := result + S1
  end;  function BS(Broj: Int64; const Rod: TGender; const Zanemari: boolean): string;
  var    i: integer;
    tmp,vrednost_reda: Int64;    min_kolicnik,max_ostatak: Int64; // // U pretrazi redova.
    max_broj: Int64;  // // U pretrazi brojeva.
    Indeks: integer; // Indeks nadjenog reda ili broja.    TmpString: string;  begin    result := '';    // Prvo nalazimo maksimalni red (on ce proizvesti minimalni kolicnik veci od 0).
    Indeks := -1;
    min_kolicnik := Broj;
    max_ostatak := -1;    for i := Low(Redovi) to High(Redovi) do
    begin
      vrednost_reda := Round(IntPower(10,Redovi[i].Order));
      tmp := Broj div vrednost_reda;
      if (tmp > 0) and (tmp < min_kolicnik) then
      begin
        min_kolicnik := tmp;
        max_ostatak := Broj mod vrednost_reda;
        Indeks := i;
      end
    end;    // Ako je red nadjen, rekurzija.
    if Indeks >= 0 then
    begin
      // Nalazimo odgovarajucu verziju naziva Reda.
      if ((min_kolicnik mod 100) >= 5) and ((min_kolicnik mod 100) <= 20) then
        TmpString := Redovi[Indeks].Name5
      else
        case min_kolicnik mod 10 of
          1:
          begin
            if (min_kolicnik = 1) and Zanemari then
              TmpString := Redovi[Indeks].Name1Ignored
            else
              TmpString := Redovi[Indeks].Name1;
          end;
          2,3,4:
            TmpString := Redovi[Indeks].Name2;
          else
            TmpString := Redovi[Indeks].Name5
        end;      if TmpString = '' then
        TmpString := Redovi[Indeks].Name1;      if TmpString = '' then
        TmpString := Redovi[Indeks].Name1Ignored;      if TmpString = '' then
        raise Exception.Create('NumberToText() Name of the order ' + IntToStr(Redovi[Indeks].Order) + ' is not set.');      // Rekurzivno obradjemo kolicnik i ostatak (red je izmedju).
      if not ((min_kolicnik = 1) and Zanemari) then
        result := AppendSepStr(result,BS(min_kolicnik,Redovi[Indeks].Gender,Zanemari));
      result := AppendSepStr(result,TmpString);
      result := AppendSepStr(result,BS(max_ostatak,gMasculine,false));    end    // Ako red nije nadjen, posmatramo Broj kao zbir elemenata niza Brojevi.
    else
    begin
      while Broj > 0 do
      begin        // Nalazimo maksimalni broj.
        Indeks := -1;
        max_broj := 0;
        for i := Low(Brojevi) to High(Brojevi) do
        begin
          tmp := Brojevi[i].Number;
          if (tmp > max_broj) and (tmp <= Broj) then
          begin
            max_broj := tmp;
            Indeks := i;
          end
        end;        if max_broj = 0 then
          exit;        Broj := Broj - max_broj;        // A zatim njegov naziv u odgovarajucem rodu nastavljamo na rezultujuci
        // string.
        TmpString := '';
        case Rod of
          gMasculine:
            TmpString := Brojevi[Indeks].NameMasculine;
          gFeminine:
          begin
            TmpString := Brojevi[Indeks].NameFeminine;
            if TmpString = '' then
              TmpString := Brojevi[Indeks].NameMasculine
          end
        end; // case Rod
        Assert(not (TmpString = ''));
        // Ovo nam cak ni ne treba.
        //result := result + TmpString;
        result := AppendSepStr(result,TmpString);      end // while Broj > 0    end // else; if Indeks >= 0  end;  // Finds masculine name of number 'N'.
  function FindNameMasc(const N: Int64): string;
  var
    i: integer;
  begin
    result := '';
    for i := Low(Brojevi) to High(Brojevi) do
      if Brojevi[i].Number = N then
      begin
        result := Brojevi[i].NameMasculine
      end
  end;  function FindZeroName: string;
  begin
    result := FindNameMasc(0)
  end;var
  TmpFrac: string;
  ZeroName: string;begin
  if Broj = 0 then
    result := FindZeroName
    //result := 'nula' // TODO: Search for zero in number names.
  else
  begin
    if Broj < 0 then
    begin
      result := MinusName;
      Broj := -Broj
    end
    else
      result := '';
    result := AppendSepStr(result,BS(Broj,gMasculine,ZanemariJedan));
  end;  // Zatim obradjijemo decimalni deo.  if Fraction < 0 then
    raise Exception.Create('NumberToText() Fraction can''t be less then zero.')
  else if Fraction > 0 then
  begin
    TmpFrac := '';
    while Fraction > 0 do
    begin
      TmpFrac := AppendSepStr(FindNameMasc(Fraction mod 10),TmpFrac);
      Fraction := Fraction div 10
    end;    ZeroName := FindZeroName;
    while FractionPos > 0 do
    begin
      TmpFrac := AppendSepStr(ZeroName,TmpFrac);
      Dec(FractionPos)
    end;    TmpFrac := AppendSepStr(DecimalSeparatorName,TmpFrac);
    result := AppendSepStr(result,TmpFrac);
  endend;

Answer 6

太长了，自己去下载控件吧.
http://vcl.vclxx.org/DELPHI/D32FREE/BCONVERT.ZIP