请大家提供转换汉字大写数字金额的源程序

Question

function SmallTOBig(small: real): string;
var SmallMonth, BigMonth: string;
  wei1, qianwei1    : string[2];
  qianwei, dianweizhi, qian: integer;
begin
   {------- 修改参数令值更精确 -------}
   {小数点后的位置，需要的话也可以改动-2值}
  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;
        {判断大写位置，可以继续增大到real类型的最大值}
          case qianwei of
            - 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;
  Result := BigMonth + '正';
end;

Answer 1

//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