人民币大写的原码，急！！！

Question

谁有将数字转换成大写的原码！我急需！

Answer 1

function Change(const S: string): string;
var
Ext:Extended;
TempStr,LeftStr,RightStr:string;    Function ChangeNum(Num:char):string;
    begin
      case Num of
      '0':Result:='零';
      '1':Result:='壹';
      '2':Result:='贰';
      '3':Result:='叁';
      '4':Result:='肆';
      '5':Result:='伍';
      '6':Result:='陆';
      '7':Result:='柒';
      '8':Result:='捌';
      '9':Result:='玖';
      else Result:='?';
      end;
    end;    Function GetDW(DW:Byte):string;
    begin
      case DW of
      1:Result:='';
      2:Result:='拾';
      3:Result:='佰';
      4:Result:='仟';
      else Result:='?';
      end;
    end;    Function GetDanWei(DanWei:Byte):string ;
    begin
      Case DanWei of
      1:Result:='元';
      2:Result:='万';
      3:Result:='亿';
      else Result:='?';
      end;
    end;    Function GetShortStr(SS:string;Sep:byte):string;
    var
    IsNotZero:boolean;
    N:byte;
    begin
       Result:='';
       for N:=Length(SS) Downto 1 do
       begin
          case SS[N] of
          '0':begin
              if IsNotZero then
                 Result:=ChangeNum(SS[N])+Result;
              IsNotZero:=false;
              end;
          '1'..'9':begin
              Result:=ChangeNum(SS[N])+GetDW(Length(SS)+1-N)+Result;
              IsNotZero:=true;
              end;
          end;
       end;
       if (Result<>'') or (Sep=1) then
          Result:=Result+GetDanWei(Sep)
       else
          Result:='';
    end;    Function ChangeRight(const RS:string):string;
    var
    FenStr:string;
    begin
      if (RS[1]='0') and (RS[2]='0') then
         begin
            Result:='';
            Exit;
         end;
      if RS[2]<>'0' then
         FenStr:=ChangeNum(RS[2])+'分';
      if RS[1]<>'0' then
         Result:=ChangeNum(RS[1])+'角'+FenStr
      else
         Result:=ChangeNum(RS[1])+FenStr;
    end;
    Function ChangeLeft(LS:string):string;
    var
    N,L:byte;
    TS:String;
    begin
       L:=((Length(LS)-1) div 4)+1;
       for N:=1 to L do
       begin
          if N=L then
          begin
             TS:=GetShortStr(LS,N)+TS
          end
          else
          begin
             TS:=GetShortStr(copy(LS,Length(LS)-3,4),N)+TS;
             LS:=Copy(LS,1,Length(LS)-4);
          end;
       end;
       Result:=TS;
    end;begin
   try
   Ext:=StrToFloat(S);
   except
     Application.MessageBox(pchar(S+'不是有效的金额'),'错误',MB_OK+MB_ICONSTOP);
     Exit;
   end;
   TempStr:=FormatFloat('0.00',Ext);
   RightStr:=copy(TempStr,Pos('.',TempStr)+1,Length(TempStr));
   LeftStr:=copy(TempStr,1,Pos('.',TempStr)-1);
   Result:=ChangeLeft(LeftStr)+ChangeRight(RightStr)+'整';
end;

Answer 2

Function XiaoxieToDaxie(f : String) : String;
var
   Fs,dx,d2,zs,xs,h,jg:string;
   i,ws,{l,}w,j,lx:integer;
begin
  f := Trim(f);
  if copy(f,1,1)='-' then begin
    Delete(f,1,1);fs:='负';end
  else fs:='';
  dx:='零壹贰叁肆伍陆柒捌玖';
  d2:='拾佰仟万亿';
  i := AnsiPos('.',f);   //小数点位置
  if i = 0 Then
     zs := f     //整数
  else begin
     zs:=copy(f,1,i - 1);  //整数部分
     xs:=copy(f,i + 1,200);
  end;
  ws:= 0; //l := 0;
  for i := Length(zs) downto 1 do begin
    ws := ws + 1; h := '';
    w:=strtoint(copy(zs, i, 1));
    if (w=0) and (i=1) then jg:='零';
    If w > 0 Then
       Case ws of
         2..5:h:=copy(d2,(ws-1)*2-1,2);
         6..8:begin
           h:=copy(d2,(ws-5)*2-1,2);
           If AnsiPos('万',jg)=0 Then h:=h+'万';
           end;
         10..13:h := copy(d2,(ws-9)*2-1, 2);
       End;
    jg:=copy(dx,(w+1)*2-1,2) + h + jg;
    If ws=9 Then jg := copy(jg,1,2) + '亿' + copy(jg,3,200);
  end;
  j:=AnsiPos('零零',jg);
  While j > 0 do begin
    jg := copy(jg, 1, j - 1) + copy(jg, j + 2,200);
    j := AnsiPos('零零',jg);
  end;
  If (Length(jg) > 1) And (copy(jg,length(jg)-1,2)='零') Then jg :=copy(jg,1,Length(jg)-2);
  j := AnsiPos('零亿',jg);
  If j > 0 Then jg := copy(jg,1, j - 1) + copy(jg, j + 2,200);
  //转换小数部分
  lx := Length(xs);
  If lx > 0 Then begin
    jg := jg + '元';
    For i := 1 To lx do begin
      if i=1 then begin
        jg := jg + copy(dx, strtoint(copy(xs,i,1))*2 + 1, 2);
        jg := jg +'角';
      end;
      if i=2 then begin
        jg := jg + copy(dx, strtoint(copy(xs,i,1))*2 + 1, 2);
        jg := jg +'分';
      end;
    end;
    j :=AnsiPos('零角零分',jg);
    if j>0 then jg := copy(jg,1,j-1)+copy(jg,j+8,200)+'整';
    j := AnsiPos('零角',jg);
    if j>0 then jg := copy(jg,1,j-1)+copy(jg,j+4,200);
    j := AnsiPos('零分',jg);
    if j>0 then jg := copy(jg,1,j-1)+copy(jg,j+4,200);
  End
  else
    jg := jg + '元整';
  result := fs+jg;
end;

Answer 3

Function NtoC( n0 :real) :String;
  Function IIF( b :boolean; s1,s2 :string) :string;
    begin if b then IIF:= s1 else IIF:=s2;
    end; //本函数的功能一目了然: 当b为真时返回s1,否则返回s2
  Const c= '零壹贰叁肆伍陆柒捌玖◇分角圆拾佰仟万拾佰仟亿拾佰仟万';
  var L,i,n, code :integer;   Z :boolean;   s,s1,s2 :string;
begin
  s:= FormatFloat( '0.00', n0);
  L:= Length( s);
  Z:= n0<1;
  For i:= 1 To L-3 do
    begin
    Val( Copy( s, L-i-2, 1), n, code);
    s1:=IIf( (n=0) And (Z Or (i=9) Or (i=5) Or (i=1)), '', Copy( c, n*2+1, 2))
      + IIf( (n=0) And ((i<>9) And (i<>5) And (i<>1) Or Z And (i=1)), '', Copy( c, (i+13)*2-1, 2))
      + s1;
    Z:= (n=0);
    end;
  Z:= False;
  For i:= 1 To 2 do
    begin
    Val( Copy( s, L-i+1, 1), n, code);
    s2:= IIf( (n=0) And ((i=1) Or (i=2) And (Z Or (n0<1))), '', Copy( c, n*2+1, 2))
       + IIf( (n>0), Copy( c,(i+11)*2-1, 2), IIf( (i=2) Or Z, '', '整'))
       + s2;
    Z:= (n=0);
    end;
  For i:= 1 To Length( s1) do If Copy(s1, i, 4) = '亿万' Then Delete(s1,i+2,2);
  NtoC:= IIf(n0=0, '零', s1+s2);
End;