如何用delphi实现下面的内容？

Question

四舍六入，五看前后，五后非零则进一，五后为零视奇偶，五前为奇则进一，五前为偶则舍去?

Answer 1

在DELPHI中Round()和RoundTo()都是四舍五入的函数，但DELPHI用的四舍五入与一般的四舍五入不同，它采用的是四舍六入五留双。
即当舍或入位大于或小于五时按四舍五入来处理，而当舍或入位等于五时，就要看前面一位是什么，根据奇进偶不进，它总是返回一个偶数值。这种算法其实是按照银行家算法，统计学上一般都用这种算法，比传统的"四舍五入"要科学。在VB、.net相关的语言中都有这个问题。

例如：
表达式 返回值
Round(11.5) 12
Round(10.5) 10
RoundTo(1234567, 3) 1234000
RoundTo(1.234, -2) 1.23
RoundTo(1.235, -2) 1.24
RoundTo(1.245, -2) 1.24
如果要使用传统的"四舍五入"方法，可以使用下面函数：
function RoundEx(R: Real): Int64;
begin
Result:= Trunc(R);
if Frac(R) >= 0.5 then
Result:= Result + 1;
end;

function DRound(const Value: Extended; const Digit: Byte = 0): Extended;
var
tmp: Extended;
begin
tmp := Power(10, Digit);
if Value > 0 then
Result := Value * tmp + 0.5
else
Result := Value * tmp - 0.5;
Result := Trunc(Result) / tmp;
end;

Answer 2

代码如下：***************************************************unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Label3: TLabel;
Edit3: TEdit;
Label4: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm}
function MakeStr(Value:Integer):string;
var
i: Integer;
str: string;
begin
str := '';
for i := 1 to Value - 1 do
begin
str := str + '0';
end;
Result := '0.' + str + '1';
end; function MyFun(source:Double;cut:Integer):string;
var
p: Integer;
Sstr, Dstr: string;
begin
Sstr := FloatToStr(source);
p := Pos('.', Sstr);
p := p + cut + 1;
if Length(Sstr) < p then
Sstr := Sstr + '0'; if p > 0 then
begin
//末位为 4 舍
if StrToInt(Sstr[p]) <= 4 then
begin
//保留整数部分
if cut = 0 then
Dstr := Copy(Sstr,1,p-2)
else
Dstr := Copy(Sstr,1,p-1);
Result := Dstr;
end
//末位为 5 判断
else if StrToInt(Sstr[p]) = 5 then
begin
//5后非0 进 1
if Length(Sstr) < p + 1 then
Sstr := Sstr + '0'; if StrToInt(Sstr[p+1]) <> 0 then
begin
//保留整数部分
if cut = 0 then
Dstr := IntToStr(StrtoInt(Copy(Sstr,1,p-2)) + 1)
else
Dstr := FloatToStr(StrToFloat(Copy(Sstr,1,p-1)) + StrToFloat(MakeStr(cut)));
Result := Dstr;
end
else begin
//保留整数部分
if cut = 0 then
begin
//5前为偶 舍
if (StrToInt(Sstr[p-2]) mod 2) = 0 then
begin
Dstr := Copy(Sstr,1,p-2);
Result := Dstr;
end
//5前为奇 进
else begin
Dstr := IntToStr(StrtoInt(Copy(Sstr,1,p-2)) + 1);
Result := Dstr;
end;
end
else
begin
//5前为偶 舍
if (StrToInt(Sstr[p-1]) mod 2) = 0 then
begin
Dstr := Copy(Sstr,1,p-1);
Result := Dstr;
end
//5前为奇 进
else begin
Dstr := FloatToStr(StrToFloat(Copy(Sstr,1,p-1)) + StrToFloat(MakeStr(cut)));
Result := Dstr;
end;
end;
end;
end
//末位为 6 进
else if StrToInt(Sstr[p]) >= 6 then
begin
//保留整数部分
if cut = 0 then
Dstr := IntToStr(StrtoInt(Copy(Sstr,1,p-2)) + 1)
else
//对应进位计算
Dstr := FloatToStr(StrToFloat(Copy(Sstr,1,p-1)) + StrToFloat(MakeStr(cut)));
Result := Dstr;
end;
end;
end; procedure TForm1.Button1Click(Sender: TObject);
var
cut: integer;
begin
cut := StrToInt(Trim(Edit3.Text));
Edit2.Text := MyFun(StrToFloat(Edit1.Text ),cut);
end; end.*************************************************实现效果：