单精度格式化函数

  1 //1.定义变量
  2 Temp_F: real = 113.05;
  3 
  4 //2.执行函数
  5 procedure TForm1.Button1Click(Sender: TObject);
  6 begin
  7   Edit1.text :=FormatFloat('0.0',Temp_F);
  8 end;
  9 
 10 procedure TForm1.Button2Click(Sender: TObject);
 11 begin
 12   Edit2.text :=FormatCurr('0.0',Temp_F);
 13 end;
 14 
 15 procedure TForm1.Button3Click(Sender: TObject);
 16   function RoundFloat(f:double;i:integer):double;
 17   var
 18     s:string;
 19     ef:extended;
 20   begin
 21     s:='#.'+StringOfChar('0',i);
 22     ef:=StrToFloat(FloatToStr(f));//防止浮点运算的误差
 23     result:=StrToFloat(FormatFloat(s,ef));
 24   end;
 25 begin
 26   Edit3.text :=FloattoStr(RoundFloat(Temp_F,2));
 27 end;
 28 
 29 procedure TForm1.Button4Click(Sender: TObject);
 30   function MyRound(s:real;non:integer):real;
 31   var
 32     roundi:integer;
 33     j:double;
 34   begin
 35     j:=s;
 36     for roundi:=10 downto non do
 37     begin
 38      j:=j+1/power(10,roundi+2);
 39      j:=roundto(j,-roundi);
 40     end;
 41     result:=j;
 42   end;
 43 begin
 44   Edit4.text :=FloattoStr(MyRound(Temp_F,3));
 45 end;
 46 
 47 procedure TForm1.Button5Click(Sender: TObject);
 48   Function FRoundInt64(x:Extended):Int64;
 49   var
 50     Temp:Extended;
 51   begin
 52     Temp:=Frac(x);
 53     if temp=0.5 then
 54       Result:=Trunc(x)+1
 55     else
 56       Result:=Trunc(x);
 57   end;
 58 begin
 59   Edit5.text :=FloattoStr(FRoundInt64(Temp_F));
 60 end;
 61 
 62 procedure TForm1.Button6Click(Sender: TObject);
 63   function DoRound(Value: Extended): Int64;
 64   procedure Set8087CW(NewCW: Word);
 65   asm
 66     MOV     Default8087CW,AX
 67     FNCLEX
 68     FLDCW   Default8087CW
 69   end;
 70   const
 71     RoundUpCW         = $1B32;
 72   var
 73     OldCW             : Word;
 74   begin
 75     OldCW := Default8087CW;
 76     try
 77       Set8087CW(RoundUpCW);
 78       Result := Round(Value);
 79     finally
 80       Set8087CW(OldCW);
 81     end;
 82   end;
 83 begin
 84   Edit6.text :=FloattoStr(DoRound(Temp_F));
 85 end;
 86 
 87 procedure TForm1.Button7Click(Sender: TObject);
 88   const
 89     defDoubleEpsilon      = 1E-12;
 90   function FRound(F: Double; ADecimal: Integer; AEpsilon: Double = defDoubleEpsilon): Double;
 91   const
 92     CDecBase: array[0..9] of Double = (
 93       1, 1E1, 1E2, 1E3, 1E4, 1E5, 1E6, 1E7, 1E8, 1E9);
 94   var
 95     P: Int64 absolute F;
 96     IntVal, DecimalVal, ModVal: Int64;
 97   begin
 98     if ADecimal < 0 then
 99     begin
100       IntVal := Trunc(F);
101       ADecimal := Abs(ADecimal);
102       if ADecimal > 9 then
103         raise Exception.CreateFmt('Not Support Param -%d.', [ADecimal]);
104       IntVal := IntVal div Trunc(CDecBase[ADecimal - 1]);
105       ModVal := IntVal mod 10;
106       IntVal := IntVal div 10;
107       if ModVal >= 5 then
108         Inc(IntVal, 1)
109       else if ModVal <= -5 then
110         Inc(IntVal, -1);
111       Result := IntVal * CDecBase[ADecimal];
112     end
113     else if ADecimal <= 8 then
114     begin
115       Inc(P, 512); // 可保留14位有效数字(13位准确,最后一位可能差1)
116       IntVal := Trunc(F);
117       DecimalVal := Trunc(Frac(F) * CDecBase[ADecimal + 1]);
118       ModVal := DecimalVal mod 10;
119       if ModVal >= 5 then
120         Inc(DecimalVal, 10)
121       else if ModVal <= -5 then
122         Inc(DecimalVal, -10);
123       Result := IntVal + (DecimalVal div 10) / CDecBase[ADecimal];
124     end
125     else begin
126       Result := StrToFloat(FormatFloat('0.' + StringOfChar('#', ADecimal), F + AEpsilon));
127       if SameValue(Result, 0.0) then Result := 0;
128     end;
129   end;
130 begin
131   Edit7.text :=FloattoStr(FRound(Temp_F,3));
132 end;