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

小数位数的保留代码

 最近写了两个小工具，要将小数部分四舍五入至一位小数和整数，可函数中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;