type
  TEnumMoneyUnitCn  = (eMUCYuan, eMUCJiao, eMUCFen); //中文货币单位枚举类型const
  cMaxCnNumMask = 12;                                 //中文货币最大数位  cCnMoney = '¥';                                    //中文货币小写符号  cCnNumCodeLw: array['0' .. '9'] of string =     //中文数字列表1
  ('○', '一', '二', '三', '四', '五', '六', '七', '八', '九');  cCnNumCodeUp: array['0' .. '9'] of string =     //中文数字列表2
  ('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');  cCnNumMaskLw: array[1 .. cMaxCnNumMask] of string = //中文数位列表1
  ('', '十', '百', '千', '万', '十', '百', '千', '乙', '十', '百', '千');  cCnNumMaskUp: array[1 .. cMaxCnNumMask] of string = //中文数位列表2
  ('', '拾', '佰', '仟', '万', '拾', '佰', '仟', '亿', '拾', '佰', '仟');  cCnMoneyCode: array[TEnumMoneyUnitCn] of string =   //中文货币单位列表
  ('圆', '角', '分');function StrLeft(const mStr: string; mDelimiter: string): string;
begin
  Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }function StrRight(const mStr: string; mDelimiter: string): string;
begin
  if Pos(mDelimiter, mStr) <= 0 then
    Result := ''
  else Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt);
end; { StrRight }function Iif(mBool: Boolean; mDataA: Variant; mDataB: Variant): Variant;
begin
  if mBool then
    Result := mDataA
  else Result := mDataB;
end; { Iif }function ZsAToC(mFloat: Real): string; { 返回中文表示的数字 }
var
  sTemp, lStr, rStr: string;
  J: Integer;{ ---------------------begin------------------------ }
  function fZsLeft(s: string): string;
  var
    I, K, Len: Integer;
    Hxm: Boolean; //出现0
    Lcy: Boolean;
  begin
    Result := '';
    Len := Length(s);
    J := 0;
    if s <> '0' then begin
      Hxm := False; Lcy := False;
      for I := 1 to Len do begin
        K := Len - I + 1;
        if s[I] <> '0' then begin
          J := 0;
          if Hxm then Result := Result + cCnNumCodeUp['0'];
          Result := Result +  Concat(cCnNumCodeUp[s[I]], cCnNumMaskUp[K]);
          Hxm := False;
          Lcy := True;
        end else begin
          Hxm := True;
          if (Lcy) and ((K + 4) mod 4 = 1) then begin
            J := K;
            if (Lcy) and (J <> 0) then Result := Result + cCnNumMaskUp[J];
            Lcy := False;
          end;
        end; { if[s[I] <> '0'] }
      end; { for }
    end { if[s <> '0'] }
    else Result := cCnNumCodeUp['0'];
  end; { fZsLeft }  function fZsRight(s: string): string;
  begin
    Result := '';
    if s <> '00' then begin
      Result := Result + Iif((Int(mFloat) = 0) and (s[1] = '0'), '',
        cCnNumCodeUp[s[1]]) + Iif(s[1] <> '0',
        cCnMoneyCode[eMUCJiao], '');
      if s[2] <> '0' then
        Result := Result + cCnNumCodeUp[s[2]] + cCnMoneyCode[eMUCFen];
    end else Result := '整';
  end; { fZsLeft }
{ ---------------------end------------------------ }begin
  if mFloat <> 0 then begin
    Str(mFloat:0:2, sTemp);
    lStr := fZsLeft(StrLeft(sTemp, '.'));
    rStr := fZsRight(StrRight(sTemp, '.'));
    Result := Iif(lStr = cCnNumCodeUp['0'], '', lStr + cCnMoneyCode[eMUCYuan])
            + rStr;
  end else Result := cCnNumCodeUp['0'] + cCnMoneyCode[eMUCYuan] + '整';
end; { ZsAToC }

解决方案 »

  1.   

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      Edit2.Text := ZsAToC(StrToFloatDef(Edit1.Text, 0));
    end;
      

  2.   

    >>zswang(伴水)(被黑中)
      我的测试中没有问题。
      

  3.   

    TO:   xhc_2000()
      首先声明:那张帖子是我发的,你拿我的帖子来说这些话是什么意思?你发帖之前问过我吗?说实话,cobi(我是小新),make11111(可可),redwoodnymph,belllab(bell)的方法我都拷贝下来了,想等有时间再作详细测试(我用的是小丸子发给我的代码),帖子我已经结了,我不管他们的程序到底有没有问题(即使有问题,也有可能是在贴的时候漏掉一点,而且小问题就不用再讲的那么详细了吧),我给分是因为他们都在尽力帮我,我很感激他们,同时也同样感谢那些帮我UP的朋友,正是因为他们,我才能够解决问题,再说一遍,多谢诸位的帮助!谢谢!  最后,我想请xhc_2000()就你所说的话向大家道歉,也请你以后你的言行负责,因为无论如何大家在帮忙!!同时,你要向我解释你的言行!!
      

  4.   

    TO:  xhc_2000()
       请尽快就你的所作所为向大家道歉!
      

  5.   

    to zzllabc(龙):有人测试是好事呀!没有必要生气!他也没有攻击大家,只是口气太重
    to xhc_2000():给大家看看你的方法,看你有什么高招
      

  6.   

    zswang(伴水)(被黑中)说的对,to xhc_2000():给大家看看你的方法,看你有什么高招