program Project1;
{$mode objfpc}{$H+}
{$modeswitch typehelpers}
uses
SysUtils, CurrUtil, Math;
type
TCurrencyHelper = type helper for currency
function RoundTo(ANumberOfDigits: integer): currency;
end;
{ jamie's RoundTo helper }
function TCurrencyHelper.RoundTo(ANumberOfDigits: integer): currency;
var
P: LongInt;
M: integer;
I: int64;
N:Boolean;
begin
Result := Self;
ANumberOfDigits := 3 - AnumberOfDigits;
if ANumberofDigits < 0 then
Exit; { Limit the fraction }
N := Self < 0; // is it negative ?
I := Abs(PInt64(@Self)^);
P := Trunc(Exp(AnumberOfDigits * ln(10)));
I := I div P;
M := I mod 10;
if M >= 5 then
I := I + 10;
I := I - M;
I := I * P;
Result := currency(Pointer(@I)^);
If N THen Result := -Result;
end;
var
vCur0, vCur1 : Currency;
vStr : string;
vLen : integer;
i : integer;
begin
PInt64(@vCur0)^ := High(int64) div 29999;
WriteLn('vCur0=',FormatCurr(',.0000', vCur0));
WriteLn;
Str(PInt64(@vCur0)^,vStr);
vLen := length(vStr);
for i := vLen - 5 downto -3 do begin
writeLn(i:2,' jamie RoundTo(',FormatCurr(',.0000', vCur0):20,')=',FormatCurr(',.0000', vCur0.RoundTo(i)):20, ' jamie');
writeLn(i:2,' pos RoundTo(',FormatCurr(',.0000', vCur0):20,')=',FormatCurr(',.0000', RoundTo( vCur0, i)):20, ' ~bk');
writeLn(i:2,' neg RoundTo(',FormatCurr(',.0000', -vCur0):20,')=',FormatCurr(',.0000', RoundTo(-vCur0, i)):20, ' ~bk');
end;
writeLn;
writeLn('pos TruncCurr(',FormatCurr(',.0000', vCur0):20,')=',FormatCurr(',.0000', TruncCurr( vCur0)):20);
writeLn('neg TruncCurr(',FormatCurr(',.0000', -vCur0):20,')=',FormatCurr(',.0000', TruncCurr(-vCur0)):20);
writeLn;
writeLn('pos CeilCurr(',FormatCurr(',.0000', vCur0):20,')=',FormatCurr(',.0000', CeilCurr( vCur0)):20);
writeLn('neg CeilCurr(',FormatCurr(',.0000', -vCur0):20,')=',FormatCurr(',.0000', CeilCurr(-vCur0)):20);
{ test 0}
writeLn;
writeLn(' 0 TruncCurr(',FormatCurr(',.0000', 0):20,')=',FormatCurr(',.0000', TruncCurr( 0)):20);
writeLn(' 0 CeilCurr(',FormatCurr(',.0000', 0):20,')=',FormatCurr(',.0000', CeilCurr( 0)):20);
ReadLn;
end.