小數位數的保留代碼與大小寫轉換

小數位數的保留代碼

 最近寫了兩個小工具，要將小數部分四捨五入至一位小數和整數，可函數中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;