RoundTo fonksiyonu hakkında;

[NewMember]

Arkadaşlar delphide kullanılan RoundTo fonksiyonu ile ondalıklı bir sayıya yuvarlama yapmak istiyorum.Ancak son hanedeki rakam 0,1,2,3,4,5 ise bir alta 6,7,8,9 ise bir üste yuvarlıyor.Oysa ben 5 ise de bir üste yuvarlamasını istiyorum.Bunu yapabileceğimiz başka bir fonksiyon varmı?Teşekkürler.

Kod: Tümünü seç

Edit2.Text:=floatToStr(Roundto(StrTofloat(Edit1.Text),-2))

Örnek:
10,235 sayısını 10,23 olarak yuvarlıyor.Ben se 10,24 olarak yuvarlamasını istiyorum.

[NewMember]

Kod: Tümünü seç

 function Yuvarla(sayi: Real): Real;
var
s:string;
VirgulNo:byte;
sonuc:Real;
xyz:integer;
begin
s:=FloatToStr(sayi);
VirgulNo:=AnsiPos(',',s);
sonuc:=StrToFloat(copy(s,1,VirgulNo+2)); 
s:=copy(s,VirgulNo+3,2);
try
xyz:=StrToInt(s);
except
xyz:=0;
end;
if xyz>=5 then sonuc:=Sonuc+0.01;
if xyz<5 Then sonuc:=sonuc;
 Result:=sonuc;
end;

[qamyoncu]

@NewMember; yazmış olduğunuz kod hatalıdır. 123,1234 yazdığınızda görüceksiniz ki sonuc 123,13 çıkacak oysa gerçek sonuç 123,12'dir.

Kod: Tümünü seç

function Yuvarla(sayi: Real;virguldensonrakibassay: Integer): Real;
var
s:string;
sonbas,sonuc:Real;
virgul: Integer;
begin
s:=FloatToStr(sayi);
sonuc:=sayi;
virgul:=AnsiPos(s,',');
sonbas:=strtofloat(Copy(s,length(s),1));
if (Copy(s,length(s)-1,1)=',') then
begin
result:=sonuc;
exit;
end
else
begin
if not (Copy(s,length(s)-virguldensonrakibassay,1)=',') then
  begin
    if sonbas>4 then
      begin
        if (copy(s,virgul+2,1)='9') then
        s:=Copy(s,1,virgul)+inttostr(strtoint(Copy(s,virgul+1,1))+1)+'0';
        sonuc:=strtofloat(Copy(s,1,length(s)-2)+inttostr(strtoint(Copy(s,length(s)-1,1))+1));
        sonuc:=Yuvarla(sonuc,virguldensonrakibassay);
      end
    else if sonbas<5 then
      begin
        if (copy(s,virgul+2,1)='0') then
        s:=Copy(s,1,virgul)+inttostr(strtoint(Copy(s,virgul+1,1))-1)+'9';
        sonuc:=strtofloat(Copy(s,1,length(s)-2)+inttostr(strtoint(Copy(s,length(s)-1,1))));
        sonuc:=Yuvarla(sonuc,virguldensonrakibassay);
      end;
  end;
end;
Result:=sonuc;
end;

Bu kod daha çok işini görecektir. Kaç basamak yuvarlayacağını da ayarlayabiliyorsun. Delphi yok şuan, deneyemedim kodu, hata olursa yazarsın tekrar.. kolay gelsin

[Lost Soul]

veya

Kod: Tümünü seç

uses
  SysUtils,Math;

function roundUp( RoundValue: real; const aDigit : TRoundToRange = 0): real;
var  eValue1: extended;
     eValue2: extended;
     Digit:TRoundToRange;
begin
  if ( aDigit >= 0) then Result:=roundTo(RoundValue,aDigit)
  else
  begin
    Digit:=Abs(aDigit);
    eValue1 := trunc( frac( RoundValue) * power(10, Digit))/ power(10, Digit);
    eValue2 := frac( RoundValue);

    if (eValue2 <= eValue1) then
      result := trunc( RoundValue) +  eValue1
    else
      result := trunc( RoundValue) +  trunc( frac( RoundValue) * power(10, Digit)+1)/ power(10, Digit);
  end;
end;

Test

Kod: Tümünü seç

writeln ('RoundUp(1234567.12345654321,-1)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,-1)));

writeln ('RoundUp(1234567.12345654321,-2)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,-2)));

writeln ('RoundUp(1234567.12345654321,-3)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,-3)));

writeln ('RoundUp(1234567.12345654321,-4)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,-4)));

writeln ('RoundUp(1234567.12345654321,-5)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,-5)));

writeln ('RoundUp(1234567.12345654321,-6)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,-6)));

writeln ('RoundUp(1234567.12345654321,-7)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,-7)));

writeln ('RoundUp(1234567.12345654321)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321)));

writeln ('RoundUp(1234567.12345654321,1)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,1)));

writeln ('RoundUp(1234567.12345654321,2)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,2)));

writeln ('RoundUp(1234567.12345654321,3)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,3)));

writeln ('RoundUp(1234567.12345654321,4)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,4)));

writeln ('RoundUp(1234567.12345654321,5)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,5)));

writeln ('RoundUp(1234567.12345654321,6)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,6)));

writeln ('RoundUp(1234567.12345654321,7)');
Writeln ('Is Now  '+FloatTosTr(RoundUp(1234567.12345654321,7)));


ReadLN;

Sonuç

Kod: Tümünü seç

RoundUp(1234567.12345654321,-1)
Is Now  1234567,2
RoundUp(1234567.12345654321,-2)
Is Now  1234567,13
RoundUp(1234567.12345654321,-3)
Is Now  1234567,124
RoundUp(1234567.12345654321,-4)
Is Now  1234567,1235
RoundUp(1234567.12345654321,-5)
Is Now  1234567,12346
RoundUp(1234567.12345654321,-6)
Is Now  1234567,123457
RoundUp(1234567.12345654321,-7)
Is Now  1234567,1234566

RoundUp(1234567.12345654321)
Is Now  1234567
RoundUp(1234567.12345654321,1)
Is Now  1234570
RoundUp(1234567.12345654321,2)
Is Now  1234600
RoundUp(1234567.12345654321,3)
Is Now  1235000
RoundUp(1234567.12345654321,4)
Is Now  1230000
RoundUp(1234567.12345654321,5)
Is Now  1200000
RoundUp(1234567.12345654321,6)
Is Now  1000000
RoundUp(1234567.12345654321,7)
Is Now  0

Kesir kısmını her zaman üste yuvarlarken Tamsayı kısmını üste yuvarlamıyor normal yuvarlamaya tabii tutuyor. Bilginize.

[ZeynelAbidin]

viewtopic.php?f=2&t=7964&p=47042&hilit=yuvarlama#p47042
linki bir incele ben yuvarlamalaarı bu şekilde yapıyorum ve bir problem çıkmıyor.

[csunguray]

Beklenen cevabı yazıyorum.

RoundTo yerine SimpleRoundTo kullanın.

RoundTo aritmetik ortalama yerine banker ortalaması alır. Aritmetik ortalama için SimpleRoundTo kullanmanız gerekir. Uses bölümüne Math unit'ini eklemeyi unutmayın.

[Lost Soul]

Beklenen cevabı yazıyorum.

RoundTo yerine SimpleRoundTo kullanın.

RoundTo aritmetik ortalama yerine banker ortalaması alır. Aritmetik ortalama için SimpleRoundTo kullanmanız gerekir. Uses bölümüne Math unit'ini eklemeyi unutmayın.

@csunguray. Aşağdaki linkte bug filan diyor ama. Doğru mudur değil midir bilmiyorum. Foksiyonu denediniz mi?

SimpleRoundTo is supposed to round midvalues up to the level of specified
precision, but some specific values fail this.

E.g. SimpleRoundTo(79.625, -2) gives the result 79.62 rather than the
expected 79.63.

We've got round it by a convoluted process of conversion from floats to
strings and back to floats again, but is there an alternative function
which works?

Trevor

http://coding.derkeiler.com/Archive/Del ... 00249.html