正确转换数字金额为人民币大写金额？十万火急！！！可在给500分

Question

//from
http://kingron.myetang.com/zsfunc0e.htm(*//
标题:中文数字表达
说明:普通方式和货币方式;和其它算法思路不一样;建议参考比较一下
设计:Zswang
日期:2002-01-25
支持:[email protected]
//*)///////Begin Source
function NumberCn(mNumber: Real): WideString;
const
  cPointCn: WideString =  '点十百千万十百千亿十百千';
  cNumberCn: WideString =  '零一二三四五六七八九';
var
  I, L, P: Integer;
  S: string;
begin
  Result := '';
  if mNumber = 0 then begin
    Result := cNumberCn[1];
    Exit;
  end;
  S := FloatToStr(mNumber);
  if Pos('.', S) <= 0 then S := S + '.';
  P := Pos('.', S);
  L := Length(S);
  for I := 1 to L do
    if P > I then
      Result := Result + cNumberCn[StrToInt(S[I]) + 1] + cPointCn[P - I]
    else if P = I then begin
      Result := StringReplace(Result, '零十零', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零百零', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零千零', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零十', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零百', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零千', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
      Result := StringReplace(Result, '零亿', '亿', [rfReplaceAll]);
      Result := StringReplace(Result, '亿万', '亿', [rfReplaceAll]);
      Result := StringReplace(Result, '零点', '点', [rfReplaceAll]);
    end else if P < I then
      Result := Result + cNumberCn[StrToInt(S[I]) + 1];
  if Result[Length(Result)] = cPointCn[1] then
    Result := Copy(Result, 1, Length(Result) - 1);
  if Result[1] = cPointCn[1] then Result := cNumberCn[1] + Result;
  if (Length(Result) > 1) and (Result[2] = cPointCn[2]) and
    (Result[1] = cNumberCn[2]) then
    Delete(Result, 1, 1);
end; { NumberCn }function MoneyCn(mMoney: Real): WideString;
var
  P: Integer;
begin
  if mMoney = 0 then begin
    Result := '无';
    Exit;
  end;
  Result := NumberCn(Round(mMoney * 100) / 100);
  Result := StringReplace(Result, '一', '壹', [rfReplaceAll]);
  Result := StringReplace(Result, '二', '贰', [rfReplaceAll]);
  Result := StringReplace(Result, '三', '叁', [rfReplaceAll]);
  Result := StringReplace(Result, '四', '肆', [rfReplaceAll]);
  Result := StringReplace(Result, '五', '伍', [rfReplaceAll]);
  Result := StringReplace(Result, '六', '陆', [rfReplaceAll]);
  Result := StringReplace(Result, '七', '柒', [rfReplaceAll]);
  Result := StringReplace(Result, '八', '捌', [rfReplaceAll]);
  Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
  Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
  Result := StringReplace(Result, '十', '拾', [rfReplaceAll]);
  Result := StringReplace(Result, '百', '佰', [rfReplaceAll]);
  Result := StringReplace(Result, '千', '仟', [rfReplaceAll]);
  P := Pos('点', Result);
  if P > 0 then begin
    Insert('分', Result, P + 3);
    Insert('角', Result, P + 2);
    Result := StringReplace(Result, '点', '圆', [rfReplaceAll]);
    Result := StringReplace(Result, '角分', '角', [rfReplaceAll]);
    Result := StringReplace(Result, '零分', '', [rfReplaceAll]);
    Result := StringReplace(Result, '零角', '', [rfReplaceAll]);
    Result := StringReplace(Result, '分角', '', [rfReplaceAll]);
    if Copy(Result, 1, 2) = '零圆' then
      Result := StringReplace(Result, '零圆', '', [rfReplaceAll]);
  end else Result := Result + '圆整';
  Result := '人民币' + Result;
end; { MoneyCn }
///////End Source///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := MoneyCn(StrToFloatDef(Edit3.Text, 0));
  Edit2.Text := NumberCn(StrToFloatDef(Edit3.Text, 0));
end;
///////End Demo

Answer 1

function Tobjectbase.smalltobig(small:real):string;
var smallmonth,bigmonth:string;
weil,qianweil:string[2];
wei,qianwei,dianweizhi,qian:integer;
begin
     qianwei:=-2;
     smallmonth:=formatfloat('0.00',small);
     dianweizhi:=pos('.',smallmonth);
     for qian:=length(smallmonth) downto 1 do
     begin
     if qian<>dianweizhi then
     begin
     case strtoint(copy(smallmonth,qian,1)) of
     1:weil:='壹';2:weil:='贰';
     3:weil:='叁';4:weil:='肆';
     5:weil:='伍';6:weil:='陆';
     7:weil:='柒';8:weil:='捌';
     9:weil:='玖';0:weil:='零';
     end;
     case qianwei of
     -3:qianweil:='厘';
     -2:qianweil:='分';
     -1:qianweil:='角';
     0:qianweil:='元';
     1:qianweil:='拾';
     2:qianweil:='佰';
     3:qianweil:='千';
     4:qianweil:='万';
     5:qianweil:='拾';
     6:qianweil:='佰';
     7:qianweil:='千';
     8:qianweil:='亿';
     9:qianweil:='十';
     10:qianweil:='佰';
     11:qianweil:='千';
     end;
     inc(qianwei);
     bigmonth:=weil+qianweil+bigmonth;
     end;
   //  end;
     smalltobig:=bigmonth;
     end;
end;

Answer 2

function NumberCn(mNumber: Real): WideString;
const
  cPointCn: WideString =  '点十百千万十百千亿十百千';
  cNumberCn: WideString =  '零一二三四五六七八九';
var
  I, L, P: Integer;
  S: string;
begin
  Result := '';
  if mNumber = 0 then begin
    Result := cNumberCn[1];
    Exit;
  end;
  S := FloatToStr(mNumber);
  if Pos('.', S) <= 0 then S := S + '.';
  P := Pos('.', S);
  L := Length(S);
  for I := 1 to L do
    if P > I then
      Result := Result + cNumberCn[StrToInt(S[I]) + 1] + cPointCn[P - I]
    else if P = I then begin
      Result := StringReplace(Result, '零十零', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零百零', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零千零', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零十', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零百', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零千', '零', [rfReplaceAll]);
      Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
      Result := StringReplace(Result, '零亿', '亿', [rfReplaceAll]);
      Result := StringReplace(Result, '亿万', '亿', [rfReplaceAll]);
      Result := StringReplace(Result, '零点', '点', [rfReplaceAll]);
    end else if P < I then
      Result := Result + cNumberCn[StrToInt(S[I]) + 1];
  if Result[Length(Result)] = cPointCn[1] then
    Result := Copy(Result, 1, Length(Result) - 1);
  if Result[1] = cPointCn[1] then Result := cNumberCn[1] + Result;
  if (Length(Result) > 1) and (Result[2] = cPointCn[2]) and
    (Result[1] = cNumberCn[2]) then
    Delete(Result, 1, 1);
end; { NumberCn }function MoneyCn(mMoney: Real): WideString;
var
  P: Integer;
begin
  if mMoney = 0 then begin
    Result := '无';
    Exit;
  end;
  Result := NumberCn(Round(mMoney * 100) / 100);
  Result := StringReplace(Result, '一', '壹', [rfReplaceAll]);
  Result := StringReplace(Result, '二', '贰', [rfReplaceAll]);
  Result := StringReplace(Result, '三', '叁', [rfReplaceAll]);
  Result := StringReplace(Result, '四', '肆', [rfReplaceAll]);
  Result := StringReplace(Result, '五', '伍', [rfReplaceAll]);
  Result := StringReplace(Result, '六', '陆', [rfReplaceAll]);
  Result := StringReplace(Result, '七', '柒', [rfReplaceAll]);
  Result := StringReplace(Result, '八', '捌', [rfReplaceAll]);
  Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
  Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
  Result := StringReplace(Result, '十', '拾', [rfReplaceAll]);
  Result := StringReplace(Result, '百', '佰', [rfReplaceAll]);
  Result := StringReplace(Result, '千', '仟', [rfReplaceAll]);
  P := Pos('点', Result);
  if P > 0 then begin
    Insert('分', Result, P + 3);
    Insert('角', Result, P + 2);
    Result := StringReplace(Result, '点', '圆', [rfReplaceAll]);
    Result := StringReplace(Result, '角分', '角', [rfReplaceAll]);
    Result := StringReplace(Result, '零分', '', [rfReplaceAll]);
    Result := StringReplace(Result, '零角', '', [rfReplaceAll]);
    Result := StringReplace(Result, '分角', '', [rfReplaceAll]);
    if Copy(Result, 1, 2) = '零圆' then
      Result := StringReplace(Result, '零圆', '', [rfReplaceAll]);
  end else Result := Result + '圆整';
  Result := '人民币' + Result;
end; { MoneyCn }
///////End Source///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := MoneyCn(StrToFloatDef(Edit3.Text, 0));
  Edit2.Text := NumberCn(StrToFloatDef(Edit3.Text, 0));
end;

Answer 3

很好用的const
  UpperNum: array[0..9] of string=('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');
  MoneyUnit: array[1..16]of String=('万','仟','佰','拾','亿','仟','佰','拾','万','仟','佰','拾','元','.','角','分');implementationfunction MoneyToUpper(const Number: Double): String;
var
  StrNumber, AUpperNum, AMoneyUnit: String;
  I: Integer;
  AZero: Boolean;
  N: Double;
begin
  AZero := False ;
  AUpperNum := '' ;
  AMoneyUnit := '' ;
  Result := '';
  if Number = 0 then
  begin
    Result := '零元整';
    Exit;
  end
  else if Number < 0 then
  begin
    Result := '负' ;
    N := - NumBer ;
  end
  else
    N := NumBer ;  Str(N:16:2, StrNumber);  for I := 1 to 16 do
  begin
    if StrNumber[I] <> ' ' then
    begin
      AMoneyUnit := MoneyUnit[I];
      if StrNumber[I] = '0' then
      begin
        if AZero and (Copy(Result,Length(Result)-1,2)='零') then
          Result := Copy(Result,1,Length(Result)-2);
        case I of
          1..4,6..8,10..12:
            begin      // 万，仟，佰，拾
              AUpperNum := '零' ;
              AMoneyUnit := '' ;
            end;
          5,9,13:
            begin      // 亿，万，元
              if StrToFloat(StrNumber) < 1 then
                AMoneyUnit := '' ;
              AUpperNum := '' ;
            end;
          15:
            begin      // 角
              if StrToFloat(StrNumber) < 1 then
                AUpperNum := ''
              else
                AUpperNum := '零' ;
              AMoneyUnit := '' ;
            end;
          16:
            begin      // 分
              AUpperNum := '' ;
              AMoneyUnit := '' ;
            end;
        end;
        AZero := True ;
      end
      else begin
        if StrNumber[I] = '.' then
        begin
          AUpperNum := '';
          AMoneyUnit := '';
        end
        else begin
          AZero := False ;
          AUpperNum := UpperNum[StrToInt(StrNumber[I])];
        end
      end;
      Result := Result + (AUpperNum + AMoneyUnit)
    end;
  end;
  Result := Result + '整' ;
end;

Answer 4

天下文章一大抄，好东西就得大家共享,hoho

Answer 5

const
//   xlWBATWorksheet = -4167;
  DigitalsUpperCase: Array [0..9] of String[2]
            =('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');
function TfrmBaseForm.NumericToVoiceFormat(Number: String; IsMoney, IsChineseFormat: Boolean): String;
Var
  I, iPos, Code: Integer;
  Value: Real;
  IsNegative: Boolean;
  DecimalPart: String;
  ReplaceStr, DisplayStr: String;
begin
  Result := Number;
  DecimalPart := '';
  IsNegative := False;
  Number := Trim(Number);
  Val(Number, Value, Code);  If Abs(Value) > 9999999999.99 then
  begin
    showmessage('不是数字或数超出范围(少于100亿)');
    Result := '';
    Exit;
  end;  if Value < 0 then
  begin
    IsNegative := True;
    Number := Copy(Number, 2, Length(Number) - 1);
  end;  iPos := Pos('.', Number);
  if iPos > 0 then
  begin
    Result := Copy(Number, 1, iPos - 1);
    DecimalPart := Copy(Number, iPos + 1, Length(Number) - iPos); //Not including '.'
  end;  if StrToInt(Result) <> 0 then
  begin
    //Example: 103456.78 -> '00000103456' and '78'
    Result :=  StringOfChar('0', 11 - Length(Result)) + Result;
    Result := Result[1]  + 'B' +  //百亿
              Result[2]  + 'S' +  //十亿
              Result[3]  + 'Y' +  //亿
              Result[4]  + 'Q' +  //千万
              Result[5]  + 'B' +  //百万
              Result[6]  + 'S' +  //十万
              Result[7]  + 'W' +  //万
              Result[8]  + 'Q' +  //千
              Result[9]  + 'B' +  //百
              Result[10] + 'S' +  //十
              Result[11];    for I := Length(Result) Downto 2 do
     if (Result[I - 1] = '0') and (Result[I] in ['Q', 'B', 'S']) then
         Delete(Result, I, 1);  //Delete Q, B, S    While (Result[1] in ['0', 'Q', 'B', 'S', 'W', 'Y']) do  //Delete *** from the head
      Delete(Result, 1, 1);
    While Result[Length(Result)] = '0' do   //Delete '0' from the tail
      Delete(Result, Length(Result), 1);
    //Delete '0' in the middle.
    //Can not has two or more continuous '0' in the middle.
    iPos := Pos('00', Result);
    While iPos > 0 do
    begin
      Delete(Result, iPos , 1);
      iPos := Pos('00', Result);
    end;    for I := Length(Result) Downto 2 do
      if (Result[I - 1] = '0') and (Result[I] in ['W', 'Y']) then  //万，亿
         Delete(Result, I - 1, 1);  //Delete '0'    for I := Length(Result) Downto 3 do
      if (Result[I - 1] in ['W', 'Y']) and (Result[I] in ['W', 'Y']) then  //亿和万不可能连在一起
         Delete(Result, I, 1);    if Copy(Result, 1, 2) = '1S' then
       Delete(Result, 1, 1);
  end;  //小数部分
  DecimalPart := StringOfChar('0', 2 - Length(DecimalPart)) + DecimalPart;
  if StrToInt(DecimalPart) = 0 then
  begin
    Result := Result + '$Z';  //Z代表'整'
    if ((Result = '0') or (Result = '-0')) and IsMoney then
       Result := '0$Z';
  end
  else  begin
    if Not IsMoney then
       Result := Result + 'D' + DecimalPart           //D:点
    else begin
       if Result = '0' then
          Result := ''
       else
          Result := Result + '$';                        //元
       if DecimalPart[1] <> '0' then
          Result := Result + DecimalPart[1] + 'P';    //角
       if DecimalPart[2] <> '0' then
          Result := Result + DecimalPart[2] + 'C';    //分
    end;
  end;  if (IsNegative) then
     Result := '-' + Result ;  if IsChineseFormat then
  begin
    DisplayStr := '';
    ReplaceStr := '';
    for I := 1 to Length(Result) do
    begin
      if Result[I] = 'Y' then
         ReplaceStr := '亿';
      if Result[I] = 'W' then
         ReplaceStr := '万';
      if Result[I] = 'Q' then
         ReplaceStr := '仟';
      if Result[I] = 'B' then
         ReplaceStr := '佰';
      if Result[I] = 'S' then
         ReplaceStr := '拾';
      if Result[I] = '$' then
         ReplaceStr := '元';
      if Result[I] = 'Z' then
         ReplaceStr := '整';
      if Result[I] = 'P' then
         ReplaceStr := '角';
      if Result[I] = 'C' then
         ReplaceStr := '分';
      if Result[I] = 'D' then
         ReplaceStr := '点';
      if Result[I] = '-' then
         ReplaceStr := '负';
      if Result[I] in ['0'..'9'] then
         ReplaceStr := DigitalsUpperCase[StrToInt(Result[I])];      DisplayStr := DisplayStr + ReplaceStr;
    end;    Result := DisplayStr;
  end;
end;

Answer 6

to dreamfan(dreamfan):转就转吧！怎么把标题说明都去掉了？
嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻
嘻嘻嘻欢迎你到这里来作客嘻嘻嘻嘻
嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻嘻
http://kingron.myetang.com/function.htm

Answer 7

function TForm1.xTOd(i:Real):string; 
const 
  d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿'; 
var 
  m,k:string; 
  j:integer; 
begin 
  k:=''; 
  m:=floattostr(int(i*100)); 
  for j:=length(m) downto 1 do 
    k:=k+d[(strtoint(m[Length(m)-j+1])+1)*2-1]+ 
      d[(strtoint(m[Length(m)-j+1])+1)*2]+d[(10+j)*2-1]+d[(10+j)*2]; 
  xTOd:=k; 
end; 调用： 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  Sum:real; 
begin 
  sum:=12.34; 
  showmessage('人民币大写:'+xTOd(Sum)); 
end; 

Answer 8

const
//   xlWBATWorksheet = -4167;
  DigitalsUpperCase: Array [0..9] of String[2]
            =('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');
function TfrmBaseForm.NumericToVoiceFormat(Number: String; IsMoney, IsChineseFormat: Boolean): String;
Var
  I, iPos, Code: Integer;
  Value: Real;
  IsNegative: Boolean;
  DecimalPart: String;
  ReplaceStr, DisplayStr: String;
begin
  Result := Number;
  DecimalPart := '';
  IsNegative := False;
  Number := Trim(Number);
  Val(Number, Value, Code);  If Abs(Value) > 9999999999.99 then
  begin
    showmessage('不是数字或数超出范围(少于100亿)');
    Result := '';
    Exit;
  end;  if Value < 0 then
  begin
    IsNegative := True;
    Number := Copy(Number, 2, Length(Number) - 1);
  end;  iPos := Pos('.', Number);
  if iPos > 0 then
  begin
    Result := Copy(Number, 1, iPos - 1);
    DecimalPart := Copy(Number, iPos + 1, Length(Number) - iPos); //Not including '.'
  end;  if StrToInt(Result) <> 0 then
  begin
    //Example: 103456.78 -> '00000103456' and '78'
    Result :=  StringOfChar('0', 11 - Length(Result)) + Result;
    Result := Result[1]  + 'B' +  //百亿
              Result[2]  + 'S' +  //十亿
              Result[3]  + 'Y' +  //亿
              Result[4]  + 'Q' +  //千万
              Result[5]  + 'B' +  //百万
              Result[6]  + 'S' +  //十万
              Result[7]  + 'W' +  //万
              Result[8]  + 'Q' +  //千
              Result[9]  + 'B' +  //百
              Result[10] + 'S' +  //十
              Result[11];    for I := Length(Result) Downto 2 do
     if (Result[I - 1] = '0') and (Result[I] in ['Q', 'B', 'S']) then
         Delete(Result, I, 1);  //Delete Q, B, S    While (Result[1] in ['0', 'Q', 'B', 'S', 'W', 'Y']) do  //Delete *** from the head
      Delete(Result, 1, 1);
    While Result[Length(Result)] = '0' do   //Delete '0' from the tail
      Delete(Result, Length(Result), 1);
    //Delete '0' in the middle.
    //Can not has two or more continuous '0' in the middle.
    iPos := Pos('00', Result);
    While iPos > 0 do
    begin
      Delete(Result, iPos , 1);
      iPos := Pos('00', Result);
    end;    for I := Length(Result) Downto 2 do
      if (Result[I - 1] = '0') and (Result[I] in ['W', 'Y']) then  //万，亿
         Delete(Result, I - 1, 1);  //Delete '0'    for I := Length(Result) Downto 3 do
      if (Result[I - 1] in ['W', 'Y']) and (Result[I] in ['W', 'Y']) then  //亿和万不可能连在一起
         Delete(Result, I, 1);    if Copy(Result, 1, 2) = '1S' then
       Delete(Result, 1, 1);
  end;  //小数部分
  DecimalPart := StringOfChar('0', 2 - Length(DecimalPart)) + DecimalPart;
  if StrToInt(DecimalPart) = 0 then
  begin
    Result := Result + '$Z';  //Z代表'整'
    if ((Result = '0') or (Result = '-0')) and IsMoney then
       Result := '0$Z';
  end
  else  begin
    if Not IsMoney then
       Result := Result + 'D' + DecimalPart           //D:点
    else begin
       if Result = '0' then
          Result := ''
       else
          Result := Result + '$';                        //元
       if DecimalPart[1] <> '0' then
          Result := Result + DecimalPart[1] + 'P';    //角
       if DecimalPart[2] <> '0' then
          Result := Result + DecimalPart[2] + 'C';    //分
    end;
  end;  if (IsNegative) then
     Result := '-' + Result ;  if IsChineseFormat then
  begin
    DisplayStr := '';
    ReplaceStr := '';
    for I := 1 to Length(Result) do
    begin
      if Result[I] = 'Y' then
         ReplaceStr := '亿';
      if Result[I] = 'W' then
         ReplaceStr := '万';
      if Result[I] = 'Q' then
         ReplaceStr := '仟';
      if Result[I] = 'B' then
         ReplaceStr := '佰';
      if Result[I] = 'S' then
         ReplaceStr := '拾';
      if Result[I] = '$' then
         ReplaceStr := '元';
      if Result[I] = 'Z' then
         ReplaceStr := '整';
      if Result[I] = 'P' then
         ReplaceStr := '角';
      if Result[I] = 'C' then
         ReplaceStr := '分';
      if Result[I] = 'D' then
         ReplaceStr := '点';
      if Result[I] = '-' then
         ReplaceStr := '负';
      if Result[I] in ['0'..'9'] then
         ReplaceStr := DigitalsUpperCase[StrToInt(Result[I])];      DisplayStr := DisplayStr + ReplaceStr;
    end;    Result := DisplayStr;
  end;
end;

Answer 9

const
//   xlWBATWorksheet = -4167;
  DigitalsUpperCase: Array [0..9] of String[2]
            =('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');
function TfrmBaseForm.NumericToVoiceFormat(Number: String; IsMoney, IsChineseFormat: Boolean): String;
Var
  I, iPos, Code: Integer;
  Value: Real;
  IsNegative: Boolean;
  DecimalPart: String;
  ReplaceStr, DisplayStr: String;
begin
  Result := Number;
  DecimalPart := '';
  IsNegative := False;
  Number := Trim(Number);
  Val(Number, Value, Code);  If Abs(Value) > 9999999999.99 then
  begin
    showmessage('不是数字或数超出范围(少于100亿)');
    Result := '';
    Exit;
  end;  if Value < 0 then
  begin
    IsNegative := True;
    Number := Copy(Number, 2, Length(Number) - 1);
  end;  iPos := Pos('.', Number);
  if iPos > 0 then
  begin
    Result := Copy(Number, 1, iPos - 1);
    DecimalPart := Copy(Number, iPos + 1, Length(Number) - iPos); //Not including '.'
  end;  if StrToInt(Result) <> 0 then
  begin
    //Example: 103456.78 -> '00000103456' and '78'
    Result :=  StringOfChar('0', 11 - Length(Result)) + Result;
    Result := Result[1]  + 'B' +  //百亿
              Result[2]  + 'S' +  //十亿
              Result[3]  + 'Y' +  //亿
              Result[4]  + 'Q' +  //千万
              Result[5]  + 'B' +  //百万
              Result[6]  + 'S' +  //十万
              Result[7]  + 'W' +  //万
              Result[8]  + 'Q' +  //千
              Result[9]  + 'B' +  //百
              Result[10] + 'S' +  //十
              Result[11];    for I := Length(Result) Downto 2 do
     if (Result[I - 1] = '0') and (Result[I] in ['Q', 'B', 'S']) then
         Delete(Result, I, 1);  //Delete Q, B, S    While (Result[1] in ['0', 'Q', 'B', 'S', 'W', 'Y']) do  //Delete *** from the head
      Delete(Result, 1, 1);
    While Result[Length(Result)] = '0' do   //Delete '0' from the tail
      Delete(Result, Length(Result), 1);
    //Delete '0' in the middle.
    //Can not has two or more continuous '0' in the middle.
    iPos := Pos('00', Result);
    While iPos > 0 do
    begin
      Delete(Result, iPos , 1);
      iPos := Pos('00', Result);
    end;    for I := Length(Result) Downto 2 do
      if (Result[I - 1] = '0') and (Result[I] in ['W', 'Y']) then  //万，亿
         Delete(Result, I - 1, 1);  //Delete '0'    for I := Length(Result) Downto 3 do
      if (Result[I - 1] in ['W', 'Y']) and (Result[I] in ['W', 'Y']) then  //亿和万不可能连在一起
         Delete(Result, I, 1);    if Copy(Result, 1, 2) = '1S' then
       Delete(Result, 1, 1);
  end;  //小数部分
  DecimalPart := StringOfChar('0', 2 - Length(DecimalPart)) + DecimalPart;
  if StrToInt(DecimalPart) = 0 then
  begin
    Result := Result + '$Z';  //Z代表'整'
    if ((Result = '0') or (Result = '-0')) and IsMoney then
       Result := '0$Z';
  end
  else  begin
    if Not IsMoney then
       Result := Result + 'D' + DecimalPart           //D:点
    else begin
       if Result = '0' then
          Result := ''
       else
          Result := Result + '$';                        //元
       if DecimalPart[1] <> '0' then
          Result := Result + DecimalPart[1] + 'P';    //角
       if DecimalPart[2] <> '0' then
          Result := Result + DecimalPart[2] + 'C';    //分
    end;
  end;  if (IsNegative) then
     Result := '-' + Result ;  if IsChineseFormat then
  begin
    DisplayStr := '';
    ReplaceStr := '';
    for I := 1 to Length(Result) do
    begin
      if Result[I] = 'Y' then
         ReplaceStr := '亿';
      if Result[I] = 'W' then
         ReplaceStr := '万';
      if Result[I] = 'Q' then
         ReplaceStr := '仟';
      if Result[I] = 'B' then
         ReplaceStr := '佰';
      if Result[I] = 'S' then
         ReplaceStr := '拾';
      if Result[I] = '$' then
         ReplaceStr := '元';
      if Result[I] = 'Z' then
         ReplaceStr := '整';
      if Result[I] = 'P' then
         ReplaceStr := '角';
      if Result[I] = 'C' then
         ReplaceStr := '分';
      if Result[I] = 'D' then
         ReplaceStr := '点';
      if Result[I] = '-' then
         ReplaceStr := '负';
      if Result[I] in ['0'..'9'] then
         ReplaceStr := DigitalsUpperCase[StrToInt(Result[I])];      DisplayStr := DisplayStr + ReplaceStr;
    end;    Result := DisplayStr;
  end;
end;

Answer 10

function Tform1.SmallTOBig(small:real):string;
var 
  SmallMonth,BigMonth:string;
  wei1,qianwei1:string[2];
  qianwei,dianweizhi,qian:integer;
begin
  qianwei:=-2;  {小数点后的位置}
  Smallmonth:=formatfloat('0.00',small);{转换成货币形式}
  dianweizhi :=pos('.',Smallmonth);{小数点的位置}
  for qian:=length(Smallmonth) downto 1 do{循环小写货币的每一位}
  begin
    if qian<>dianweizhi then{如果读到的不是小数点就继续}
    begin
      case strtoint(copy(Smallmonth,qian,1)) of
        1:wei1:='壹'; 2:wei1:='贰';
        3:wei1:='叁'; 4:wei1:='肆';
        5:wei1:='伍'; 6:wei1:='陆';
        7:wei1:='柒'; 8:wei1:='捌';
        9:wei1:='玖'; 0:wei1:='零';
      end;
      case qianwei of{判断大写位置，可以继续增大到real类型的最大值}
        -3:qianwei1:='厘';
        -2:qianwei1:='分';
        -1:qianwei1:='角';
        0 :qianwei1:='元';
        1 :qianwei1:='拾';
        2 :qianwei1:='佰';
        3 :qianwei1:='千';
        4 :qianwei1:='万';
        5 :qianwei1:='拾';
        6 :qianwei1:='佰';
        7 :qianwei1:='千';
        8 :qianwei1:='亿';
        9 :qianwei1:='十';
        10:qianwei1:='佰';
        11:qianwei1:='千';
      end;
      inc(qianwei);
      BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额}
    end;
  end;
  SmallTOBig:=BigMonth;
end;//Note: It need to perfect when then sums include 0

Answer 11

凑凑热闹，另外一个版本，我在使用的。来自于Kingron的收集资料。
function  TForm1.My_StrToRMB(curs: string) :string ;
var
  daxie,danwei,minuscurs:string;
  i,j,deccount :integer ;
  rmb :int64;
begin
  curs:=trim(curs);
  if (curs='-') or (curs='.') or (curs='') then  // '.','-',''错
  begin
    result:='ERROR';
    exit;
  end;
  deccount :=0;
  for i:=1 to length(curs) do
  begin
    if  not (curs[i]  in ['0'..'9','.','-']) then     //'123w2'错
    begin
      result:='ERROR';
      exit;
    end;
    if (curs[i]='.') and (deccount>0) then  //'12313.324.23'错
    begin
      result:='ERROR';
      exit;
    end;
    if (curs[i]='-') and (i>1) then        //'-123-123'错
    begin
      result:='ERROR';
      exit;
    end;
    if curs[i]='.' then  inc(deccount);
  end;
  rmb:=round(StrToFloat(curs)*100);
  minuscurs:='';  //负数标志
  if rmb<0 then
  begin
    minuscurs:='(负数)' ;
    rmb:=(-1)*rmb;
  end;
  if rmb>=1E18 then     //超过9千万亿
  begin
    result:='ERROR';
    exit;
  end;
  curs:='';
  i:=0; j:=0 ;
  while rmb>0 do
  begin
    j:= rmb mod 10;
    case j of
      0 : daxie :='零' ;
      1 : daxie :='壹' ;
      2 : daxie :='贰' ;
      3 : daxie :='叁' ;
      4 : daxie :='肆' ;
      5 : daxie :='伍' ;
      6 : daxie :='陆' ;
      7 : daxie :='柒' ;
      8 : daxie :='捌' ;
      9 : daxie :='玖' ;
    end;
    case i of
      0 : danwei :='分' ;
      1 : danwei :='角' ;
      2 : danwei :='圆' ;
      3 : danwei :='拾' ;
      4 : danwei :='佰' ;
      5 : danwei :='仟' ;
      6 : danwei :='万' ;
      7 : danwei :='拾' ;
      8 : danwei :='佰' ;
      9 : danwei :='仟' ;
      10 : danwei :='亿' ;
      11 : danwei :='拾' ;
      12 : danwei :='佰' ;
      13 : danwei :='仟' ;
      14 : danwei :='万' ;
      15 : danwei :='拾' ;
      16 : danwei :='佰' ;
      17 : danwei :='仟' ;
    end;
    rmb:=rmb div 10;
    if j<>0 then curs:=daxie+danwei+curs;      //该位上不为0
    if (j=0) and (not (i in [2,6,10,14])) then //该位为0，是一般位
        curs:=daxie+curs;
    if (j=0) and  (i in [2,6,10,14]) then      //该位为0，是敏感位
        curs:=danwei+curs;
    inc(i);
  end;
  while pos('零零',curs)>0  do  curs:=stringreplace(curs,'零零','零',[]);
  curs:=stringreplace(curs,'零圆','圆',[]);
  while pos('零万',curs)>0  do curs:=stringreplace(curs,'零万','万',[]); //上万亿后可能两个'零万'
  curs:=stringreplace(curs,'零亿','亿',[]);
  curs:=stringreplace(curs,'角零','角',[]);
  if copy(curs,length(curs)-3,4)='圆零' then  //最后两位是圆零.
      curs:=stringreplace(curs,'圆零','圆整',[]);  //小数点后
  curs:=stringreplace(curs,'亿万','亿',[]);
  if curs='' then curs:='零圆整';
  result:=minuscurs+curs;
end;

Answer 12

function xd(xx:currency):string;
var
dx,ws,ot:string;
I,cd,q,w:integer;
int:currency;
ling:Boolean;begin
int:=trunc((abs(xx)+0.005)*100);
cd:=length(currtostr(int));
dx:='零壹贰叁肆伍陆柒捌玖';
ws:='分角元拾佰仟万拾佰仟亿拾佰仟兆';
ot:='';
ling:=false;
i:=1;while i<=cd do
beginif copy(currtostr(int),I,1)<>'0' then
begin
ot:=ot+copy(dx,strtoint(copy(currtostr(int),I,1))*2+1,2);
ot:=ot+copy(ws,(cd-I)*2+1,2);
ling:=false;
i:=i+1;
endelse if  ling=false and (copy(currtostr(int),I,1)='0' ) then   {遇0}
begin
      if cd-i+1>6 then             {万以上}
      begin
       w:=0;
           for q:=7 to cd-i+1 do
           begin
           w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
           end ;
            if w=0 then            {整万}
             begin
             ot:=ot+'万';
             i:=cd-6+1;
             end
             else
             begin
             ot:=ot+'零';
             i:=i+1;
             ling:=true;
             end;
       end
       else  if (cd-i+1>2) then    {元以上}
       begin
       w:=0;
           for q:=3 to cd-i+1 do
           begin
           w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
           end ;
             if w=0 then
             begin
             ot:=ot+'元' ;           {整元}
             i:=cd-2+1 ;
             end
             else
             begin
             ot:=ot+'零';
             i:=i+1;
             ling:=true;
             end;
       end
       else  if (cd-i+1>0) then       {分以上}
       begin
       w:=0;
           for q:=1 to cd-i+1 do
           begin
           w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
           end ;
             if w=0 then
             begin
             ot:=ot+'整' ;             {整分}
             i:=cd+1 ;
             end
             else
             begin
             ot:=ot+'零';
             i:=i+1;
             ling:=true;
             end;
       end;
endelse if (copy(currtostr(int),I,1)='0') and (ling=true) then
begin
I:=i+1;
end;end;if xx>0 then
xd:=ot
else
xd:='负'+ot;
end;

Answer 13

{上一贴只算到万,下面是算到千亿的我想应该够了吧}
function xd(xx:currency):string;
var
dx,ws,ot:string;
I,cd,q,w:integer;
int:currency;
ling:Boolean;begin
int:=trunc((abs(xx)+0.005)*100);
cd:=length(currtostr(int));
dx:='零壹贰叁肆伍陆柒捌玖';
ws:='分角元拾佰仟万拾佰仟亿拾佰仟';
ot:='';
ling:=false;
i:=1;while i<=cd do
beginif copy(currtostr(int),I,1)<>'0' then
begin
ot:=ot+copy(dx,strtoint(copy(currtostr(int),I,1))*2+1,2);
ot:=ot+copy(ws,(cd-I)*2+1,2);
ling:=false;
i:=i+1;
endelse if  ling=false and (copy(currtostr(int),I,1)='0' ) then   {遇0}
begin
      if cd-i+1>10 then   {亿以上}
      begin
       w:=0;
           for q:=11 to cd-i+1 do
           begin
           w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
           end ;
            if w=0 then     {整亿}
             begin
             ot:=ot+'亿';
             i:=cd-10+1;
             end ;
          end
             else if cd-i+1>6 then   {万以上}
      begin
       w:=0;
           for q:=7 to cd-i+1 do
           begin
           w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
           end ;
            if (w=0) and (cd-i-6>2) then i:=cd-6+1     {整万}
             else if w=0 then
             begin
             ot:=ot+'万';
             i:=cd-6+1;
             end
             else
             begin
             ot:=ot+'零';
             i:=i+1;
             ling:=true;
             end;
       end
       else  if (cd-i+1>2) then
       begin
       w:=0;
           for q:=3 to cd-i+1 do
           begin
           w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
           end ;
             if w=0 then
             begin
             ot:=ot+'元' ;
             i:=cd-2+1 ;
             end
             else
             begin
             ot:=ot+'零';
             i:=i+1;
             ling:=true;
             end;
       end
       else  if (cd-i+1>0) then
       begin
       w:=0;
           for q:=1 to cd-i+1 do
           begin
           w:=w+strtoint(copy(currtostr(int),cd-q+1,1));
           end ;
             if w=0 then
             begin
             ot:=ot+'整' ;
             i:=cd+1 ;
             end
             else
             begin
             ot:=ot+'零';
             i:=i+1;
             ling:=true;
             end;
       end;
endelse if (copy(currtostr(int),I,1)='0') and (ling=true) then
begin
I:=i+1;
end;end;if xx>0 then
xd:=ot
else
xd:='负'+ot;
end;
end.

Answer 14

这样一个转换，好像不需要这么长的一个代码吧？
算法其实很简单，
1.根据数字所在位置，可以确定['十万','万'....],等信息，这些信息放在一个书组内，依靠下标即可取得，哪来这么多stringreplace阿
2.数字的转换，只要取得该数字，将数字的中文放在一个数组内['零','壹'...]
用数字作下标，直接就完成了转换
楼上各位的算法真是匪夷所思

Answer 15

//代码来自32位深度历险台湾钱达智先生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 16

我支持 ylm163net(文秀) 所说的算法!!如再不明白请与我联系!!
[email protected]