Dephi阿拉伯数字转换成英文和中文大写

Code
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleServer, ExcelXP, comobj, Spin;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  myexcel,myworkbook,mysheet:variant;
  glb,t1 :integer;
implementation

{$R *.dfm}
//------------------------
//将阿拉伯数字转成英文字串
//------------------------
function num2ceng(strArabic:string):string;//不带小数点英文转换中文
const
  sw:array[2..9]of string=(\'twenty\',\'thirty\',\'forty\',\'fifty\',\'sixty\',\'seventy\',\'eighty\',\'ninety\');
  gw:array[1..19] of string=(\'one\',\'two\',\'three\',\'four\',\'five\',\'six\',\'seven\',\'eight\',\'nine\',\'ten\',\'eleven\',\'twelve\',\'thirteen\',\'fourteen\',\'fifteen\',\'sixteen\',\'seventeen\',\'eighteen\',\'nineteen\');
  exp:array[1..4] of string=(\'\',\'thousand\',\'million\',\'billion\');
var
  t,j:integer;
  ts:string;
  function readu1000(ss:string):string;
  var
    t,code:integer;
    begin
    result := \'\';
      while ss[1]=\'0\' do
      begin
        delete(ss,1,1);
        if length(ss)=0 then exit;//控制全是0情况
      end;
    if length(ss)=3 then
      begin
        appendstr(result,gw[ord(ss[1])-ord(\'0\')]);
        appendstr(result,\' hundred \');
        delete(ss,1,1);
      end;
    while ss[1]=\'0\' do
      begin
        delete(ss,1,1);
        if length(ss)=0 then exit;
      end;
   if length(ss)<>0 then
    if result <> \'\' then appendstr(result,\'and \');
    if (glb = 1) and (t1<>1) then //超过百位时候处理最后3位
      if result=\'\' then appendstr(result,\'and \');
    begin
      val(ss,t,code);
      if t<20 then result :=result+gw[t]
      else if t mod 10=0 then result:=result+sw[t div 10]
      else result := result+sw[trunc(t/10)]+\'-\'+gw[t mod 10];
   end;
  end;
begin
  result :=\'Say \';
  t := pos(\'.\',strArabic);
  if t=0 then t:=length(strArabic)+1;
  while (t mod 3<>1)do
    begin
        t:=t+1;
      strArabic:=\'0\'+ strArabic;
    end;
  t1:=(t-1) div 3;
  for glb:=t1 downto 1 do
  begin
      ts:=\'\';
      for j:=1 to 3 do
      begin
           ts:=ts+ strArabic[1];
        delete(strArabic,1,1);
      end;
    result := result + readu1000(ts);
    if ts<>\'000\' then result := result+\' \'+exp[glb]+\' \';
  end;
  if length(strArabic)<>0 then
  begin
      delete(strArabic,1,1);
    appendstr(result,\'and \');
    result :=result + readu1000(strArabic);
  end;
end;
function num2cengnum(strArabic:string):string;
const
  gw:array[1..10] of string =(\'0\',\'one\',\'two\',\'three\',\'four\',\'five\',\'six\',\'seven\',\'eight\',\'nine\');
var
  p,i,j,x:integer;
  s:string;
begin
   result := \'\';
   s := strarabic;
   p := pos(\'.\',strarabic);
   if p = 0 then
    begin
      result := num2ceng(strarabic)+\'Only\';
      exit;
    end
   else
    begin
      i := length(s)-p;//计算小数点后面有几位
      delete(strarabic,p,i+1);//删除小数点后面数字
      result := num2ceng(strarabic)+\'Point\';
    end;
    for x:=1 to i do //转换小数点后面数字
      begin
        j:= strtoint(copy(s,p+x,1));
        case j of
          0: result := result +\' \'+gw[1];
          1: result := result +\' \'+gw[2];
          2: result := result +\' \'+gw[3];
          3: result := result +\' \'+gw[4];
          4: result := result +\' \'+gw[5];
          5: result := result +\' \'+gw[6];
          6: result := result +\' \'+gw[7];
          7: result := result +\' \'+gw[8];
          8: result := result +\' \'+gw[9];
          9: result := result +\' \'+gw[10];
        end;
      end;
end;
//-----------------------------------------
// Num2CNum  将阿拉伯数字转成中文数字字串
//------------------------------------------
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;---没有限制小数点后面位置}
      i := iPosOfDecimalPoint + 1;
      iDigit := Ord(sArabic[i]) - 48;
      if Copy(_ChineseNumeric, 2 * iDigit + 1, 2) <> \'零\' then
        begin
          AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
          Result := Result+\'角\';
        end
      else
        begin
          AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
        end;
      i := i+1;
      iDigit := Ord(sArabic[i]) - 48;
      AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
      Result := Result+\'分\'
    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 iposofdecimalpoint = 0 then result := result + \'元整\';
  (* 是否为负数 *)
  if bMinus then Result := \'负\' + Result;
{$IFDEF __Debug}
  ShowMessage(\'Result before Exit: \' + Result);
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  opendialog1.Execute;
  edit1.Text := opendialog1.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  introw,intnum,i,col1,col2,col3:integer;
  filename :string;
begin
  try
    if application.MessageBox(\'你确定要转换么？\',\'信息提示：\',mb_yesno+mb_defbutton1+mb_iconinformation)= idyes then
    begin
      if fileexists(edit1.Text) = false then
        begin
          showmessage(\'文件不存在，请重新选择文件\');
          exit;
        end;
      myexcel:= CreateOleObject(\'Excel.Application\');
      myworkbook := myexcel.workbooks.open(edit1.text);
      myexcel.Visible := false;
      mysheet := myexcel.worksheets[1];
      introw := mysheet.UsedRange.Rows.Count;//计算多少行
      col1 := spinedit1.Value;
      col2 := spinedit2.Value;
      col3 := spinedit3.Value;
      for i:=1 to introw do
        begin
          myexcel.cells[i,col2].value := Num2CNum(strtofloat(myexcel.cells[i,col1].value));
          myexcel.cells[i,col3].value := num2cengnum(myexcel.cells[i,col1].value);
        end;
      intnum :=length(extractfilename(edit1.Text))-4;
      filename :=extractfilepath(edit1.Text)+copy(extractfilename(edit1.text),1,intnum)+\'1\'+extractfileext(edit1.Text);
      if fileexists(filename) then
        showmessage(\'已经存在转换完成文件,不能重复转换!\')
      else
        begin
          mysheet.saveas(filename);
          showmessage(\'恭喜,转换完成为\'+filename);
        end;
      myexcel.quit;
    end;
  except
    showmessage(\'意外错误，查看是否选择正确文件和是否安装Excel\');
    //myexcel.quit;
    myexcel := unassigned;
    exit;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  opendialog1.Execute;
  myexcel := createoleobject(\'excel.application\');
  myexcel.visible := true;
  myexcel.workbooks.open(opendialog1.FileName);
end;

end.