小数位数的保留代码与大小写转换

小数位数的保留代码

 最近写了两个小工具，要将小数部分四舍五入至一位小数和整数，可函数中round()是所谓的银行家进位法，实在用不了。无奈找度娘询问了一阵，结果不尽人情呀，最后找到一个保留两位小数的代码，通过修改后令人满意。现分享大家留着备用：
============================

保留1位小数

===========================

 function BL1(s: real): real;

var

r1, r2: real;

s1, s2: string;

begin

r1 := int(s);

r2 := frac(s);

s1 := copy(floattostr(r1), 1, length(floattostr(r1)));

if length(floattostr(r2)) >= 4 then

begin

if strtoint(copy((floattostr(r2)), 4, 1)) >= 5 then   //小数第三位开始复制一位0.00

if strtoint(copy((floattostr(r2)), 3, 1)) = 9 then
begin

s1 := inttostr(strtoint(s1) + 1);

s2 := '';

end

 else

 S2 := inttostr(strtoint(copy((floattostr(r2)), 3, 1)) + 1)

else if copy((floattostr(r2)), 3, 1) = '0' then

  s2:=''

else s2 := copy(floattostr(r2), 3, 1);

end

 else s2 := copy(floattostr(r2), 3, 1);

result := strtofloat(s1 + '.' + s2);

end;
====================

调用

=====================

 label3.Caption  :=floattostr(BL(strtofloat(edit1.text)));

================================

四舍五入到整数

================================

function BL0(s: real): real;

var

r1, r2: real;

s1, s2: string;

begin

r1 := int(s); //取整数部分

r2 := frac(s); //取小数部分

s1 := copy(floattostr(r1), 1, length(floattostr(r1)));   //复制R1,复制位数为R1长度

if length(floattostr(r2)) >= 3 then     //如果小数部分长度>=3
if strtoint(copy((floattostr(r2)), 3, 1)) >= 5 then  //从小数部分第三位开始复制一位数
s1 := inttostr(strtoint(s1) + 1); //如果第一位小数大于5就向整数个位进1

 result := strtofloat(s1);

 end;

 
 
========================================================
四舍五入保留两位代码
========================================================

function BL2(s: real): real;

var

r1, r2: real;

s1, s2: string;

begin

r1 := int(s);

r2 := frac(s);

s1 := copy(floattostr(r1), 1, length(floattostr(r1)));

if length(floattostr(r2)) >= 5 then

begin

if strtoint(copy((floattostr(r2)), 5, 1)) >= 5 then

if strtoint(copy((floattostr(r2)), 4, 1)) = 9 then

if strtoint(copy((floattostr(r2)), 3, 1)) = 9 then

begin

s1 := inttostr(strtoint(s1) + 1);

s2 := '';

end

else

S2 := inttostr(strtoint(copy((floattostr(r2)), 3, 1)) + 1)

else if copy((floattostr(r2)), 3, 1) = '0' then

S2 := '0' + inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1)

else s2 := inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1)

else s2 := copy(floattostr(r2), 3, 2);

end

else s2 := copy(floattostr(r2), 3, 2);

result := strtofloat(s1 + '.' + s2);

end;
 
 
================================================

大小写转换

================================================

function TForm1.ConvertMoney(Num: Real): String;

var

  intstr,decstr,s: String;

  intlen,declen,i: word;

begin

  Intstr:= intToStr(Trunc(Num));

  decstr := FloatToStr(RoundTo(Frac(num),-1));//对小数进行四舍五入

   //decstr := FloatToStr(RoundTo(Frac(num),-2));//对小数进行四舍五入

  decstr := copy(decstr,3,Length(decstr)-1);

  declen := Length(decstr);

  intlen := Length(Intstr);

  For i :=  1 to Intlen do

  begin

    Case StrToInt(Intstr[i]) of

      0: begin

           if (copy(s,Length(s)-1,2)<>'零')  then

             s := s+'零';

         end;

      1: s := s+'壹';

      2: s := s+'贰';

      3: s := s+'叁';

 4: s := s+'肆';

      5: s := s+'伍';

      6: s := s+'陆';

      7: s := s+'柒';

      8: s := s+'捌';

      9: s := s+'玖';

    end;

     case intlen-i+1 of

       13: begin

             if (StrToInt(Intstr[i])<>0)then

               s := s+'万';

           end;

       12: begin

             if (StrToInt(Intstr[i])<>0) then

               s := s+'仟';

           end;

       11: begin

             if (StrToInt(Intstr[i])<>0) then

               s := s+'佰';

           end;

       10: begin

             if (StrToInt(Intstr[i])<>0) then

             begin

               //if (copy(s,Length(s)-1,2) ='壹')then

                // s := copy(s,0,Length(s)-2);

               s := s+'拾';

             end;

           end;

       9: begin

              if (StrToInt(Intstr[i])<>0) then

  s := s+'亿'

              else

              begin

                if (copy(s,Length(s)-1,2) ='零')then

                  s := copy(s,0,Length(s)-2);

                  s := s+'亿';

              end;

           end;

       8: begin

             if (StrToInt(Intstr[i])<>0) then

               s := s+'仟';

           end;

       7: begin

             if (StrToInt(Intstr[i])<>0)then

               s := s+'佰';

           end;

       6: begin

             if (StrToInt(Intstr[i])<>0) then

             begin

               if (copy(s,Length(s)-1,2) ='壹')then

                 s := copy(s,0,Length(s)-2);

               s := s+'拾';

             end;

           end;

       5: begin

             if (StrToInt(Intstr[i])<>0) then

              s := s+'万'

              else

              begin

                  s := copy(s,0,Length(s)-2);

if (copy(s,Length(s)-1,2) <>'亿')then

                  s := s+'万'

                else

                  s := s+'零';

              end;

           end;

       4: begin

             if (StrToInt(Intstr[i])<>0) then

               s := s+'仟';

           end;

       3: begin

             if (StrToInt(Intstr[i])<>0) then

               s := s+'佰';

           end;

       2: begin

             if (StrToInt(Intstr[i])<>0) then

               s := s+'拾';

           end;

       1: begin

             if (copy(s,Length(s)-1,2) ='零')then

               s := copy(s,0,Length(s)-2);

               s := s+'元';

           end;

     end;

  end;

  For i := 1 to declen do

  begin

Case StrToInt(decstr[i]) of

      0: begin

           if (copy(s,Length(s)-1,2)<>'零')  then

             s := s+'零';

         end;

      1: s := s+'壹';

      2: s := s+'贰';

      3: s := s+'叁';

      4: s := s+'肆';

      5: s := s+'伍';

      6: s := s+'陆';

      7: s := s+'柒';

      8: s := s+'捌';

      9: s := s+'玖';

    end;

    case i of

      1: begin

            if (StrToInt(decstr[i])<>0)then

              s := s+'角';

          end;

      2: begin

            if (StrToInt(decstr[i])<>0) then

              s := s+'分';

          end;

    end;

  end;

  Result := s;

end;