52 |
|
|
53 |
|
} |
54 |
|
|
55 |
< |
function NewNumeric(aValue: AnsiString): IFBNumeric; overload; |
56 |
< |
function NewNumeric(aValue: double; aScale: integer): IFBNumeric; overload; |
57 |
< |
function NewNumeric(aValue: TBCD): IFBNumeric; overload; |
58 |
< |
function NewNumeric(aValue: currency): IFBNumeric; overload; |
59 |
< |
function NewNumeric(aValue: Int64): IFBNumeric; overload; |
55 |
> |
function StrToNumeric(aValue: AnsiString): IFBNumeric; |
56 |
> |
function DoubleToNumeric(aValue: double): IFBNumeric; |
57 |
> |
function BCDToNumeric(aValue: TBCD): IFBNumeric; |
58 |
> |
function CurrToNumeric(aValue: currency): IFBNumeric; |
59 |
> |
function IntToNumeric(aValue: Int64): IFBNumeric; |
60 |
|
function NumericFromRawValues(aValue: Int64; aScale: integer): IFBNumeric; |
61 |
+ |
function NumericToDouble(aValue: Int64; aScale: integer): double; |
62 |
|
|
63 |
|
function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean; |
63 |
– |
function NumericToDouble(aValue: Int64; aScale: integer): double; |
64 |
|
|
65 |
|
function SafeSmallInt(aValue: Int64): Smallint; |
66 |
|
function SafeInteger(aValue: Int64): integer; |
67 |
|
|
68 |
+ |
{Numeric Arithmetic} |
69 |
+ |
function NumericAdd(x,y: IFBNumeric): IFBNumeric; overload; {returns x + y} |
70 |
+ |
function NumericSubtract(x,y: IFBNumeric): IFBNumeric; overload; {returns x - y} |
71 |
+ |
function NumericMultiply(x,y: IFBNumeric): IFBNumeric; overload; {returns x * y} |
72 |
+ |
function NumericDivide(x,y: IFBNumeric): IFBNumeric; overload; {returns x / y} |
73 |
+ |
function NumericCompare(x,y: IFBNumeric): integer; overload; {returns -1: x < y; 0: x = y; 1: x > y} |
74 |
+ |
function NegateNumeric(x: IFBNumeric): IFBNumeric; overload; {returns -x} |
75 |
+ |
|
76 |
+ |
{integer operations} |
77 |
+ |
function NumericAdd(x: IFBNumeric; y: int64): IFBNumeric; overload; {returns x + y} |
78 |
+ |
function NumericSubtract(x: IFBNumeric; y: int64): IFBNumeric; overload; {returns x - y} |
79 |
+ |
function NumericSubtract(x: int64; y: IFBNumeric): IFBNumeric; overload; {returns x - y} |
80 |
+ |
function NumericMultiply(x: IFBNumeric; y: int64): IFBNumeric; overload; {returns x * y} |
81 |
+ |
function NumericDivide(x: IFBNumeric; y: int64): IFBNumeric; overload; {returns x / y} |
82 |
+ |
function NumericDivide(x: int64; y: IFBNumeric): IFBNumeric; overload; {returns x / y} |
83 |
+ |
function NumericCompare(x: IFBNumeric; y: int64): integer; overload; {returns -1: x < y; 0: x = y; 1: x > y} |
84 |
+ |
|
85 |
+ |
{floating point operations} |
86 |
+ |
function NumericAdd(x: IFBNumeric; y: double): IFBNumeric; overload; {returns x + y} |
87 |
+ |
function NumericSubtract(x: IFBNumeric; y: double): IFBNumeric; overload; {returns x - y} |
88 |
+ |
function NumericSubtract(x: double; y: IFBNumeric): IFBNumeric; overload; {returns x - y} |
89 |
+ |
function NumericMultiply(x: IFBNumeric; y: double): IFBNumeric; overload; {returns x * y} |
90 |
+ |
function NumericDivide(x: IFBNumeric; y: double): IFBNumeric; overload; {returns x div y} |
91 |
+ |
function NumericDivide(x: double; y: IFBNumeric): IFBNumeric; overload; {returns x div y} |
92 |
+ |
function NumericCompare(x: IFBNumeric; y: double): integer; overload; {returns -1: x < y; 0: x = y; 1: x > y} |
93 |
|
|
94 |
|
implementation |
95 |
|
|
105 |
|
private |
106 |
|
FValue: Int64; |
107 |
|
FScale: integer; |
83 |
– |
// function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64; |
108 |
|
public |
109 |
< |
constructor Create(aValue: Int64; aScale: integer); overload; |
110 |
< |
constructor Create(aValue: Int64); overload; |
111 |
< |
constructor Create(aValue: AnsiString); overload; |
112 |
< |
constructor Create(aValue: double; aScale: integer); overload; |
113 |
< |
constructor Create(aValue: Currency); overload; |
114 |
< |
constructor Create(aValue: TBCD); overload; |
109 |
> |
constructor Create(aValue: Int64; aScale: integer); |
110 |
> |
constructor CreateFromInt(aValue: Int64); |
111 |
> |
constructor CreateFromStr(aValue: AnsiString); |
112 |
> |
constructor CreateFromDouble(aValue: double); |
113 |
> |
constructor CreateFromCurr(aValue: Currency); |
114 |
> |
constructor CreateFromBCD(aValue: TBCD); |
115 |
|
public |
116 |
|
{IFBNumeric} |
117 |
|
function getRawValue: Int64; |
118 |
|
function getScale: integer; |
119 |
< |
function clone(aNewScale: integer): IFBNumeric; |
119 |
> |
function AdjustScaleTo(aNewScale: integer): IFBNumeric; |
120 |
|
function getAsString: AnsiString; |
121 |
|
function getAsDouble: double; |
122 |
|
function getAsCurrency: Currency; |
126 |
|
function getAsSmallInt: SmallInt; {scaled - may be truncated} |
127 |
|
end; |
128 |
|
|
129 |
< |
function NewNumeric(aValue: AnsiString): IFBNumeric; |
129 |
> |
function StrToNumeric(aValue: AnsiString): IFBNumeric; |
130 |
|
begin |
131 |
< |
Result := TFBNumeric.Create(aValue); |
131 |
> |
Result := TFBNumeric.CreateFromStr(aValue); |
132 |
|
end; |
133 |
|
|
134 |
< |
function NewNumeric(aValue: double; aScale: integer): IFBNumeric; |
134 |
> |
function DoubleToNumeric(aValue: double): IFBNumeric; |
135 |
|
begin |
136 |
< |
Result := TFBNumeric.Create(aValue,aScale); |
136 |
> |
Result := TFBNumeric.CreateFromDouble(aValue); |
137 |
|
end; |
138 |
|
|
139 |
< |
function NewNumeric(aValue: TBCD): IFBNumeric; |
139 |
> |
function BCDToNumeric(aValue: TBCD): IFBNumeric; |
140 |
|
begin |
141 |
< |
Result := TFBNumeric.Create(aValue); |
141 |
> |
Result := TFBNumeric.CreateFromBCD(aValue); |
142 |
|
end; |
143 |
|
|
144 |
< |
function NewNumeric(aValue: currency): IFBNumeric; |
144 |
> |
function CurrToNumeric(aValue: currency): IFBNumeric; |
145 |
|
begin |
146 |
< |
Result := TFBNumeric.Create(aValue); |
146 |
> |
Result := TFBNumeric.CreateFromCurr(aValue); |
147 |
|
end; |
148 |
|
|
149 |
< |
function NewNumeric(aValue: Int64): IFBNumeric; |
149 |
> |
function IntToNumeric(aValue: Int64): IFBNumeric; |
150 |
|
begin |
151 |
< |
Result := TFBNumeric.Create(aValue); |
151 |
> |
Result := TFBNumeric.CreateFromINT(aValue); |
152 |
|
end; |
153 |
|
|
154 |
|
function NumericFromRawValues(aValue: Int64; aScale: integer): IFBNumeric; |
253 |
|
Result := aValue; |
254 |
|
end; |
255 |
|
|
256 |
< |
{ TFBNumeric } |
256 |
> |
{AdjustScale returns a raw int64 value derived from x but with aNewScale} |
257 |
|
|
258 |
< |
(*function TFBNumeric.AdjustScaleFromCurrency(Value: Currency; aScale: Integer |
259 |
< |
): Int64; |
260 |
< |
var |
261 |
< |
Scaling : Int64; |
262 |
< |
i : Integer; |
263 |
< |
begin |
264 |
< |
Result := 0; |
265 |
< |
Scaling := 1; |
266 |
< |
if aScale < 0 then |
267 |
< |
begin |
268 |
< |
for i := -1 downto aScale do |
245 |
< |
Scaling := Scaling * 10; |
246 |
< |
result := trunc(Value * Scaling); |
247 |
< |
end |
258 |
> |
function AdjustScale(x: IFBNumeric; aNewScale: integer): int64; |
259 |
> |
var rValue: double; |
260 |
> |
begin |
261 |
> |
rValue := x.getrawValue; |
262 |
> |
Result := Round(rValue * IntPower(10,x.getScale-aNewScale)); |
263 |
> |
end; |
264 |
> |
|
265 |
> |
function CompareInt(a,b: integer): integer; |
266 |
> |
begin |
267 |
> |
if a < b then |
268 |
> |
Result := -1 |
269 |
|
else |
270 |
< |
if aScale > 0 then |
271 |
< |
begin |
272 |
< |
for i := 1 to aScale do |
273 |
< |
Scaling := Scaling * 10; |
274 |
< |
result := trunc(Value / Scaling); |
275 |
< |
end |
270 |
> |
if a = b then |
271 |
> |
Result := 0 |
272 |
> |
else |
273 |
> |
Result := 1; |
274 |
> |
end; |
275 |
> |
|
276 |
> |
function NumericAdd(x, y: IFBNumeric): IFBNumeric; |
277 |
> |
begin |
278 |
> |
case CompareInt(x.getScale,y.getScale) of |
279 |
> |
0: |
280 |
> |
Result := NumericFromRawValues(x.getRawValue + y.getRawValue,x.getScale); |
281 |
> |
1: |
282 |
> |
Result := NumericFromRawValues(AdjustScale(x,y.getscale) + y.getRawValue,y.getScale); |
283 |
|
else |
284 |
< |
result := trunc(Value); |
285 |
< |
end;*) |
284 |
> |
Result := NumericFromRawValues(AdjustScale(y,x.getscale) + x.getRawValue,x.getScale); |
285 |
> |
end; |
286 |
> |
end; |
287 |
> |
|
288 |
> |
function NumericSubtract(x, y: IFBNumeric): IFBNumeric; |
289 |
> |
begin |
290 |
> |
case CompareInt(x.getScale,y.getScale) of |
291 |
> |
0: |
292 |
> |
Result := NumericFromRawValues(x.getRawValue - y.getRawValue,x.getScale); |
293 |
> |
1: |
294 |
> |
Result := NumericFromRawValues(AdjustScale(x,y.getscale) - y.getRawValue,y.getScale); |
295 |
> |
else |
296 |
> |
Result := NumericFromRawValues(AdjustScale(y,x.getscale) - x.getRawValue,x.getScale); |
297 |
> |
end; |
298 |
> |
end; |
299 |
> |
|
300 |
> |
function NumericMultiply(x, y: IFBNumeric): IFBNumeric; |
301 |
> |
begin |
302 |
> |
Result := NumericFromRawValues(x.getRawValue * y.getRawValue,x.getScale+y.getScale); |
303 |
> |
end; |
304 |
> |
|
305 |
> |
function NumericDivide(x, y: IFBNumeric): IFBNumeric; |
306 |
> |
var z: double; |
307 |
> |
begin |
308 |
> |
{Compute actual value as a double} |
309 |
> |
z := (x.getRawValue / y.getRawValue) * IntPower(10, x.getScale - y.getScale); |
310 |
> |
{Return numeric at original no. of decimal places of numerator} |
311 |
> |
Result := DoubleTONumeric(z).AdjustScaleTo(x.getScale); |
312 |
> |
end; |
313 |
> |
|
314 |
> |
function NumericCompare(x, y: IFBNumeric): integer; |
315 |
> |
begin |
316 |
> |
case CompareInt(x.getScale,y.getScale) of |
317 |
> |
0: |
318 |
> |
Result := CompareInt(x.getRawValue,y.getRawValue); |
319 |
> |
1: |
320 |
> |
Result := CompareInt(AdjustScale(x,y.getscale),y.getRawValue); |
321 |
> |
else |
322 |
> |
Result := CompareInt(x.getRawValue,AdjustScale(y,x.getscale)); |
323 |
> |
end; |
324 |
> |
end; |
325 |
> |
|
326 |
> |
function NegateNumeric(x: IFBNumeric): IFBNumeric; |
327 |
> |
begin |
328 |
> |
Result := NumericFromRawValues(-x.getRawValue,x.getScale); |
329 |
> |
end; |
330 |
> |
|
331 |
> |
function NumericAdd(x: IFBNumeric; y: int64): IFBNumeric; |
332 |
> |
begin |
333 |
> |
Result := NumericAdd(x,IntToNumeric(y)); |
334 |
> |
end; |
335 |
> |
|
336 |
> |
function NumericSubtract(x: IFBNumeric; y: int64): IFBNumeric; |
337 |
> |
begin |
338 |
> |
Result := NumericSubtract(x,IntToNumeric(y)); |
339 |
> |
end; |
340 |
> |
|
341 |
> |
function NumericSubtract(x: int64; y: IFBNumeric): IFBNumeric; |
342 |
> |
begin |
343 |
> |
Result := NumericSubtract(IntToNumeric(x),y); |
344 |
> |
end; |
345 |
> |
|
346 |
> |
function NumericMultiply(x: IFBNumeric; y: int64): IFBNumeric; |
347 |
> |
begin |
348 |
> |
Result := NumericMultiply(x,IntToNumeric(y)); |
349 |
> |
end; |
350 |
> |
|
351 |
> |
function NumericDivide(x: IFBNumeric; y: int64): IFBNumeric; |
352 |
> |
begin |
353 |
> |
Result := NumericDivide(x,IntToNumeric(y)); |
354 |
> |
end; |
355 |
> |
|
356 |
> |
function NumericDivide(x: int64; y: IFBNumeric): IFBNumeric; |
357 |
> |
begin |
358 |
> |
Result := NumericDivide(IntToNumeric(x),y); |
359 |
> |
end; |
360 |
> |
|
361 |
> |
function NumericCompare(x: IFBNumeric; y: int64): integer; |
362 |
> |
begin |
363 |
> |
Result := NumericCompare(x,IntToNumeric(y)); |
364 |
> |
end; |
365 |
> |
|
366 |
> |
function NumericAdd(x: IFBNumeric; y: double): IFBNumeric; |
367 |
> |
begin |
368 |
> |
Result := NumericAdd(x,DoubleToNumeric(y)); |
369 |
> |
end; |
370 |
> |
|
371 |
> |
function NumericSubtract(x: IFBNumeric; y: double): IFBNumeric; |
372 |
> |
begin |
373 |
> |
Result := NumericSubtract(x,DoubleToNumeric(y)); |
374 |
> |
end; |
375 |
> |
|
376 |
> |
function NumericSubtract(x: double; y: IFBNumeric): IFBNumeric; |
377 |
> |
begin |
378 |
> |
Result := NumericSubtract(DoubleToNumeric(x),y); |
379 |
> |
end; |
380 |
> |
|
381 |
> |
function NumericMultiply(x: IFBNumeric; y: double): IFBNumeric; |
382 |
> |
begin |
383 |
> |
Result := NumericMultiply(x,DoubleToNumeric(y)); |
384 |
> |
end; |
385 |
> |
|
386 |
> |
function NumericDivide(x: IFBNumeric; y: double): IFBNumeric; |
387 |
> |
begin |
388 |
> |
Result := NumericDivide(x,DoubleToNumeric(y)); |
389 |
> |
end; |
390 |
> |
|
391 |
> |
function NumericDivide(x: double; y: IFBNumeric): IFBNumeric; |
392 |
> |
begin |
393 |
> |
Result := NumericDivide(DoubleToNumeric(x),y); |
394 |
> |
end; |
395 |
> |
|
396 |
> |
function NumericCompare(x: IFBNumeric; y: double): integer; |
397 |
> |
begin |
398 |
> |
Result := NumericCompare(x,DoubleToNumeric(y)); |
399 |
> |
end; |
400 |
|
|
401 |
|
constructor TFBNumeric.Create(aValue: Int64; aScale: integer); |
402 |
|
begin |
405 |
|
FScale := aScale; |
406 |
|
end; |
407 |
|
|
408 |
< |
constructor TFBNumeric.Create(aValue: Int64); |
408 |
> |
constructor TFBNumeric.CreateFromInt(aValue: Int64); |
409 |
|
begin |
410 |
|
inherited Create; |
411 |
|
FValue := aValue; |
412 |
|
FScale := 0; |
413 |
|
end; |
414 |
|
|
415 |
< |
constructor TFBNumeric.Create(aValue: AnsiString); |
415 |
> |
constructor TFBNumeric.CreateFromStr(aValue: AnsiString); |
416 |
|
begin |
417 |
|
inherited Create; |
418 |
|
if not TryStrToNumeric(aValue,FValue,FScale) then |
419 |
|
IBError(ibxeInvalidDataConversion,[aValue]); |
420 |
|
end; |
421 |
|
|
422 |
< |
constructor TFBNumeric.Create(aValue: double; aScale: integer); |
423 |
< |
var |
424 |
< |
Scaling : Int64; |
283 |
< |
i : Integer; |
284 |
< |
begin |
285 |
< |
inherited Create; |
286 |
< |
FScale := aScale; |
287 |
< |
FValue := 0; |
288 |
< |
Scaling := 1; |
289 |
< |
if aScale < 0 then |
422 |
> |
constructor TFBNumeric.CreateFromDouble(aValue: double); |
423 |
> |
|
424 |
> |
function WithinLimits(a: double): boolean; |
425 |
|
begin |
426 |
< |
for i := -1 downto aScale do |
427 |
< |
Scaling := Scaling * 10; |
428 |
< |
FValue := trunc(aValue * Scaling); |
429 |
< |
end |
430 |
< |
else |
431 |
< |
if aScale > 0 then |
426 |
> |
a := abs(frac(a)); |
427 |
> |
Result := (a > 0.001) and (a < 0.999); {avoid small rounding errors converting to decimal} |
428 |
> |
end; |
429 |
> |
|
430 |
> |
var aScale: integer; |
431 |
> |
i: int64; |
432 |
> |
begin |
433 |
> |
aScale := 0; |
434 |
> |
while WithinLimits(AValue) do |
435 |
|
begin |
436 |
< |
for i := 1 to aScale do |
437 |
< |
Scaling := Scaling * 10; |
438 |
< |
FValue := trunc(aValue / Scaling); |
439 |
< |
end |
440 |
< |
else |
303 |
< |
FValue := trunc(aValue); |
304 |
< |
// writeln('Adjusted ',Value,' to ',Result); |
436 |
> |
aValue := aValue * 10; |
437 |
> |
Inc(aScale); |
438 |
> |
end; |
439 |
> |
i := Round(aValue); |
440 |
> |
Create(i,-aScale); |
441 |
|
end; |
442 |
|
|
443 |
< |
constructor TFBNumeric.Create(aValue: Currency); |
443 |
> |
constructor TFBNumeric.CreateFromCurr(aValue: Currency); |
444 |
|
begin |
445 |
|
inherited Create; |
446 |
|
Move(aValue,FValue,sizeof(Int64)); |
447 |
|
FScale := -4; |
448 |
|
end; |
449 |
|
|
450 |
< |
constructor TFBNumeric.Create(aValue: TBCD); |
450 |
> |
constructor TFBNumeric.CreateFromBCD(aValue: TBCD); |
451 |
|
var ScaledBCD: TBCD; |
452 |
|
begin |
453 |
|
inherited Create; |
466 |
|
Result := FScale; |
467 |
|
end; |
468 |
|
|
469 |
< |
function TFBNumeric.clone(aNewScale: integer): IFBNumeric; |
469 |
> |
function TFBNumeric.AdjustScaleTo(aNewScale: integer): IFBNumeric; |
470 |
|
begin |
471 |
|
if FScale = aNewScale then |
472 |
|
Result := TFBNumeric.Create(FValue,FScale) |
473 |
|
else |
474 |
< |
Result := TFBNumeric.Create(Round(FValue * IntPower(10,FScale-aNewScale)),aNewScale); |
474 |
> |
Result := TFBNumeric.Create(AdjustScale(self,aNewScale),aNewScale); |
475 |
|
end; |
476 |
|
|
477 |
|
function TFBNumeric.getAsString: AnsiString; |
520 |
|
begin |
521 |
|
if FScale <> -4 then |
522 |
|
begin |
523 |
< |
value := clone(-4).GetRawValue; |
523 |
> |
value := AdjustScaleTo(-4).GetRawValue; |
524 |
|
Move(value,Result,sizeof(Currency)); |
525 |
|
end |
526 |
|
else |
527 |
|
Move(FValue,Result,sizeof(Currency)); |
528 |
|
end; |
529 |
|
|
394 |
– |
(*var |
395 |
– |
Scaling : Int64; |
396 |
– |
i : Integer; |
397 |
– |
FractionText, PadText, CurrText: AnsiString; |
398 |
– |
begin |
399 |
– |
Result := 0; |
400 |
– |
Scaling := 1; |
401 |
– |
PadText := ''; |
402 |
– |
if FScale > 0 then |
403 |
– |
begin |
404 |
– |
for i := 1 to FScale do |
405 |
– |
Scaling := Scaling * 10; |
406 |
– |
result := FValue * Scaling; |
407 |
– |
end |
408 |
– |
else |
409 |
– |
if FScale < 0 then |
410 |
– |
begin |
411 |
– |
for i := -1 downto FScale do |
412 |
– |
Scaling := Scaling * 10; |
413 |
– |
FractionText := IntToStr(abs(FValue mod Scaling)); |
414 |
– |
for i := Length(FractionText) to -FScale -1 do |
415 |
– |
PadText := '0' + PadText; |
416 |
– |
{$IF declared(DefaultFormatSettings)} |
417 |
– |
with DefaultFormatSettings do |
418 |
– |
{$ELSE} |
419 |
– |
{$IF declared(FormatSettings)} |
420 |
– |
with FormatSettings do |
421 |
– |
{$IFEND} |
422 |
– |
{$IFEND} |
423 |
– |
if FValue < 0 then |
424 |
– |
CurrText := '-' + IntToStr(Abs(FValue div Scaling)) + DecimalSeparator + PadText + FractionText |
425 |
– |
else |
426 |
– |
CurrText := IntToStr(Abs(FValue div Scaling)) + DecimalSeparator + PadText + FractionText; |
427 |
– |
try |
428 |
– |
result := StrToCurr(CurrText); |
429 |
– |
except |
430 |
– |
on E: Exception do |
431 |
– |
IBError(ibxeInvalidDataConversion, [nil]); |
432 |
– |
end; |
433 |
– |
end |
434 |
– |
else |
435 |
– |
result := FValue; |
436 |
– |
end; *) |
437 |
– |
|
530 |
|
function TFBNumeric.getAsBCD: TBCD; |
531 |
|
begin |
532 |
|
Result := DoubleToBCD(getAsDouble); |