代码function sswr(ss:string;j:integer):string;//j代表想要保留的小数点后的位数,SS是传进来的值
var
arr:array of pchar;
k,i,cd:integer;
begin
result:='';
cd:=length(ss);
setlength(arr,cd);
for i:=1 to cd do begin
arr[i]:=pchar(copy(ss,i,1));
case j of
1: begin
if arr[i]='.' then begin
if cd-i<2 then begin
result:=ss;
break;
end else begin
k:=i;
k:=k+2;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.0';
break;
end;
end;
2: begin
if arr[i]='.' then begin
if cd-i<3 then begin
case (cd-i) of
1: begin
result:=ss+'0';
break;
end;
2:begin
result:=ss;
break;
end;
end;
end else begin
k:=i;
k:=k+3;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.0';
break;
end;
end;
3: begin
if arr[i]='.' then begin
if cd-i<4 then begin
case (cd-i) of
1: begin
result:=ss+'00';
break;
end;
2: begin
result:=ss+'0';
break;
end;
3:begin
result:=ss;
break;
end; end;
end else begin
k:=i;
k:=k+4;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.000';
break;
end; end;
4: begin
if arr[i]='.' then begin
if cd-i<5 then begin
case (cd-i) of
1: begin
result:=ss+'000';
break;
end;
2: begin
result:=ss+'00';
break;
end;
3: begin
result:=ss+'0';
break;
end;
4:begin
result:=ss;
break;
end; end;
end else begin
k:=i;
k:=k+5;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.0000';
break;
end;
end;
5: begin
if arr[i]='.' then begin
if cd-i<6 then begin
case (cd-i) of
1: begin
result:=ss+'0000';
break;
end;
2: begin
result:=ss+'000';
break;
end;
3: begin
result:=ss+'00';
break;
end;
4: begin
result:=ss+'0';
break;
end;
5:begin
result:=ss;
break;
end; end;
end else begin
k:=i;
k:=k+6;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.00000';
break;
end;
end;
end;
end;
end;
var
arr:array of pchar;
k,i,cd:integer;
begin
result:='';
cd:=length(ss);
setlength(arr,cd);
for i:=1 to cd do begin
arr[i]:=pchar(copy(ss,i,1));
case j of
1: begin
if arr[i]='.' then begin
if cd-i<2 then begin
result:=ss;
break;
end else begin
k:=i;
k:=k+2;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.0';
break;
end;
end;
2: begin
if arr[i]='.' then begin
if cd-i<3 then begin
case (cd-i) of
1: begin
result:=ss+'0';
break;
end;
2:begin
result:=ss;
break;
end;
end;
end else begin
k:=i;
k:=k+3;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.0';
break;
end;
end;
3: begin
if arr[i]='.' then begin
if cd-i<4 then begin
case (cd-i) of
1: begin
result:=ss+'00';
break;
end;
2: begin
result:=ss+'0';
break;
end;
3:begin
result:=ss;
break;
end; end;
end else begin
k:=i;
k:=k+4;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.000';
break;
end; end;
4: begin
if arr[i]='.' then begin
if cd-i<5 then begin
case (cd-i) of
1: begin
result:=ss+'000';
break;
end;
2: begin
result:=ss+'00';
break;
end;
3: begin
result:=ss+'0';
break;
end;
4:begin
result:=ss;
break;
end; end;
end else begin
k:=i;
k:=k+5;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.0000';
break;
end;
end;
5: begin
if arr[i]='.' then begin
if cd-i<6 then begin
case (cd-i) of
1: begin
result:=ss+'0000';
break;
end;
2: begin
result:=ss+'000';
break;
end;
3: begin
result:=ss+'00';
break;
end;
4: begin
result:=ss+'0';
break;
end;
5:begin
result:=ss;
break;
end; end;
end else begin
k:=i;
k:=k+6;
arr[k]:=pchar(copy(ss,k,1));
if arr[k]<='4' then begin
result:=copy(ss,1,k-1);
break;
end else begin
arr[k-1]:=arr[k-1]+1;
result:=copy(ss,1,k-2)+arr[k-1];
break;
end;
end;
end;
if i=cd then
begin
result:=ss+'.00000';
break;
end;
end;
end;
end;
end;
begin
x := x * exp(n*ln(10));
if (int(x) * 10 + 5) > int(x * 10) then
begin
result := floor(x);
end else
begin
result := ceil(x);
end;
result := result /exp(n*ln(10));
end;调用
var
y :extended;
begin
y := myRound(3.1415926,4);
end;
直接使用RoundTo函数,需要uses中加入math。
RoundTo(1.245, -2); = 1.25需要注意的是,旧的Delphi版本Round函数采用的是四舍六入,逢五的时候是前面是奇数才入,是偶数则不入,delphi手册帮助中的示例如下:
RoundTo(1234567, 3) 1234000
RoundTo(1.234, -2) 1.23
RoundTo(1.235, -2) 1.24
RoundTo(1.245, -2) 1.24但delphi 7已经不是这样的了,是直接四舍五入的:RoundTo(1.245, -2) = 1.25。