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; |
231 |
|
end; |
232 |
|
|
233 |
|
function NumericToDouble(aValue: Int64; aScale: integer): double; |
234 |
+ |
var rValue: extended; |
235 |
|
begin |
236 |
< |
Result := aValue * IntPower(10,aScale); |
236 |
> |
rValue := aValue; |
237 |
> |
Result := rValue * IntPower(10,aScale); |
238 |
|
end; |
239 |
|
|
240 |
|
function SafeSmallInt(aValue: Int64): Smallint; |
255 |
|
Result := aValue; |
256 |
|
end; |
257 |
|
|
258 |
< |
{ TFBNumeric } |
258 |
> |
{AdjustScale returns a raw int64 value derived from x but with aNewScale} |
259 |
|
|
260 |
< |
(*function TFBNumeric.AdjustScaleFromCurrency(Value: Currency; aScale: Integer |
261 |
< |
): Int64; |
262 |
< |
var |
263 |
< |
Scaling : Int64; |
264 |
< |
i : Integer; |
239 |
< |
begin |
240 |
< |
Result := 0; |
241 |
< |
Scaling := 1; |
242 |
< |
if aScale < 0 then |
260 |
> |
function AdjustScale(x: IFBNumeric; aNewScale: integer): int64; |
261 |
> |
begin |
262 |
> |
Result := x.getRawValue; |
263 |
> |
aNewScale := x.getScale - aNewScale; |
264 |
> |
while aNewScale < 0 do |
265 |
|
begin |
266 |
< |
for i := -1 downto aScale do |
267 |
< |
Scaling := Scaling * 10; |
268 |
< |
result := trunc(Value * Scaling); |
269 |
< |
end |
248 |
< |
else |
249 |
< |
if aScale > 0 then |
266 |
> |
Result := Round(Result / 10); |
267 |
> |
Inc(aNewScale); |
268 |
> |
end; |
269 |
> |
while aNewScale > 0 do |
270 |
|
begin |
271 |
< |
for i := 1 to aScale do |
272 |
< |
Scaling := Scaling * 10; |
273 |
< |
result := trunc(Value / Scaling); |
274 |
< |
end |
271 |
> |
Result := Result * 10; |
272 |
> |
Dec(aNewScale); |
273 |
> |
end; |
274 |
> |
end; |
275 |
> |
|
276 |
> |
function CompareInt(a,b: integer): integer; |
277 |
> |
begin |
278 |
> |
if a < b then |
279 |
> |
Result := -1 |
280 |
> |
else |
281 |
> |
if a = b then |
282 |
> |
Result := 0 |
283 |
> |
else |
284 |
> |
Result := 1; |
285 |
> |
end; |
286 |
> |
|
287 |
> |
function NumericAdd(x, y: IFBNumeric): IFBNumeric; |
288 |
> |
begin |
289 |
> |
case CompareInt(x.getScale,y.getScale) of |
290 |
> |
0: |
291 |
> |
Result := NumericFromRawValues(x.getRawValue + y.getRawValue,x.getScale); |
292 |
> |
1: |
293 |
> |
Result := NumericFromRawValues(AdjustScale(x,y.getscale) + y.getRawValue,y.getScale); |
294 |
> |
else |
295 |
> |
Result := NumericFromRawValues(AdjustScale(y,x.getscale) + x.getRawValue,x.getScale); |
296 |
> |
end; |
297 |
> |
end; |
298 |
> |
|
299 |
> |
function NumericSubtract(x, y: IFBNumeric): IFBNumeric; |
300 |
> |
begin |
301 |
> |
case CompareInt(x.getScale,y.getScale) of |
302 |
> |
0: |
303 |
> |
Result := NumericFromRawValues(x.getRawValue - y.getRawValue,x.getScale); |
304 |
> |
1: |
305 |
> |
Result := NumericFromRawValues(AdjustScale(x,y.getscale) - y.getRawValue,y.getScale); |
306 |
> |
else |
307 |
> |
Result := NumericFromRawValues(AdjustScale(y,x.getscale) - x.getRawValue,x.getScale); |
308 |
> |
end; |
309 |
> |
end; |
310 |
> |
|
311 |
> |
function NumericMultiply(x, y: IFBNumeric): IFBNumeric; |
312 |
> |
begin |
313 |
> |
Result := NumericFromRawValues(x.getRawValue * y.getRawValue,x.getScale+y.getScale); |
314 |
> |
end; |
315 |
> |
|
316 |
> |
function NumericDivide(x, y: IFBNumeric): IFBNumeric; |
317 |
> |
var z: double; |
318 |
> |
begin |
319 |
> |
{Compute actual value as a double} |
320 |
> |
z := (x.getRawValue / y.getRawValue) * IntPower(10, x.getScale - y.getScale); |
321 |
> |
{Return numeric at original no. of decimal places of numerator} |
322 |
> |
Result := DoubleTONumeric(z).AdjustScaleTo(x.getScale); |
323 |
> |
end; |
324 |
> |
|
325 |
> |
function NumericCompare(x, y: IFBNumeric): integer; |
326 |
> |
begin |
327 |
> |
case CompareInt(x.getScale,y.getScale) of |
328 |
> |
0: |
329 |
> |
Result := CompareInt(x.getRawValue,y.getRawValue); |
330 |
> |
1: |
331 |
> |
Result := CompareInt(AdjustScale(x,y.getscale),y.getRawValue); |
332 |
|
else |
333 |
< |
result := trunc(Value); |
334 |
< |
end;*) |
333 |
> |
Result := CompareInt(x.getRawValue,AdjustScale(y,x.getscale)); |
334 |
> |
end; |
335 |
> |
end; |
336 |
> |
|
337 |
> |
function NegateNumeric(x: IFBNumeric): IFBNumeric; |
338 |
> |
begin |
339 |
> |
Result := NumericFromRawValues(-x.getRawValue,x.getScale); |
340 |
> |
end; |
341 |
> |
|
342 |
> |
function NumericAdd(x: IFBNumeric; y: int64): IFBNumeric; |
343 |
> |
begin |
344 |
> |
Result := NumericAdd(x,IntToNumeric(y)); |
345 |
> |
end; |
346 |
> |
|
347 |
> |
function NumericSubtract(x: IFBNumeric; y: int64): IFBNumeric; |
348 |
> |
begin |
349 |
> |
Result := NumericSubtract(x,IntToNumeric(y)); |
350 |
> |
end; |
351 |
> |
|
352 |
> |
function NumericSubtract(x: int64; y: IFBNumeric): IFBNumeric; |
353 |
> |
begin |
354 |
> |
Result := NumericSubtract(IntToNumeric(x),y); |
355 |
> |
end; |
356 |
> |
|
357 |
> |
function NumericMultiply(x: IFBNumeric; y: int64): IFBNumeric; |
358 |
> |
begin |
359 |
> |
Result := NumericMultiply(x,IntToNumeric(y)); |
360 |
> |
end; |
361 |
> |
|
362 |
> |
function NumericDivide(x: IFBNumeric; y: int64): IFBNumeric; |
363 |
> |
begin |
364 |
> |
Result := NumericDivide(x,IntToNumeric(y)); |
365 |
> |
end; |
366 |
> |
|
367 |
> |
function NumericDivide(x: int64; y: IFBNumeric): IFBNumeric; |
368 |
> |
begin |
369 |
> |
Result := NumericDivide(IntToNumeric(x),y); |
370 |
> |
end; |
371 |
> |
|
372 |
> |
function NumericCompare(x: IFBNumeric; y: int64): integer; |
373 |
> |
begin |
374 |
> |
Result := NumericCompare(x,IntToNumeric(y)); |
375 |
> |
end; |
376 |
> |
|
377 |
> |
function NumericAdd(x: IFBNumeric; y: double): IFBNumeric; |
378 |
> |
begin |
379 |
> |
Result := NumericAdd(x,DoubleToNumeric(y)); |
380 |
> |
end; |
381 |
> |
|
382 |
> |
function NumericSubtract(x: IFBNumeric; y: double): IFBNumeric; |
383 |
> |
begin |
384 |
> |
Result := NumericSubtract(x,DoubleToNumeric(y)); |
385 |
> |
end; |
386 |
> |
|
387 |
> |
function NumericSubtract(x: double; y: IFBNumeric): IFBNumeric; |
388 |
> |
begin |
389 |
> |
Result := NumericSubtract(DoubleToNumeric(x),y); |
390 |
> |
end; |
391 |
> |
|
392 |
> |
function NumericMultiply(x: IFBNumeric; y: double): IFBNumeric; |
393 |
> |
begin |
394 |
> |
Result := NumericMultiply(x,DoubleToNumeric(y)); |
395 |
> |
end; |
396 |
> |
|
397 |
> |
function NumericDivide(x: IFBNumeric; y: double): IFBNumeric; |
398 |
> |
begin |
399 |
> |
Result := NumericDivide(x,DoubleToNumeric(y)); |
400 |
> |
end; |
401 |
> |
|
402 |
> |
function NumericDivide(x: double; y: IFBNumeric): IFBNumeric; |
403 |
> |
begin |
404 |
> |
Result := NumericDivide(DoubleToNumeric(x),y); |
405 |
> |
end; |
406 |
> |
|
407 |
> |
function NumericCompare(x: IFBNumeric; y: double): integer; |
408 |
> |
begin |
409 |
> |
Result := NumericCompare(x,DoubleToNumeric(y)); |
410 |
> |
end; |
411 |
|
|
412 |
|
constructor TFBNumeric.Create(aValue: Int64; aScale: integer); |
413 |
|
begin |
416 |
|
FScale := aScale; |
417 |
|
end; |
418 |
|
|
419 |
< |
constructor TFBNumeric.Create(aValue: Int64); |
419 |
> |
constructor TFBNumeric.CreateFromInt(aValue: Int64); |
420 |
|
begin |
421 |
|
inherited Create; |
422 |
|
FValue := aValue; |
423 |
|
FScale := 0; |
424 |
|
end; |
425 |
|
|
426 |
< |
constructor TFBNumeric.Create(aValue: AnsiString); |
426 |
> |
constructor TFBNumeric.CreateFromStr(aValue: AnsiString); |
427 |
|
begin |
428 |
|
inherited Create; |
429 |
|
if not TryStrToNumeric(aValue,FValue,FScale) then |
430 |
|
IBError(ibxeInvalidDataConversion,[aValue]); |
431 |
|
end; |
432 |
|
|
433 |
< |
constructor TFBNumeric.Create(aValue: double; aScale: integer); |
434 |
< |
var |
435 |
< |
Scaling : Int64; |
283 |
< |
i : Integer; |
284 |
< |
begin |
285 |
< |
inherited Create; |
286 |
< |
FScale := aScale; |
287 |
< |
FValue := 0; |
288 |
< |
Scaling := 1; |
289 |
< |
if aScale < 0 then |
433 |
> |
constructor TFBNumeric.CreateFromDouble(aValue: double); |
434 |
> |
|
435 |
> |
function WithinLimits(a: double): boolean; |
436 |
|
begin |
437 |
< |
for i := -1 downto aScale do |
438 |
< |
Scaling := Scaling * 10; |
439 |
< |
FValue := trunc(aValue * Scaling); |
440 |
< |
end |
441 |
< |
else |
442 |
< |
if aScale > 0 then |
437 |
> |
a := abs(frac(a)); |
438 |
> |
Result := (a > 0.001) and (a < 0.999); {avoid small rounding errors converting to decimal} |
439 |
> |
end; |
440 |
> |
|
441 |
> |
var aScale: integer; |
442 |
> |
i: int64; |
443 |
> |
begin |
444 |
> |
aScale := 0; |
445 |
> |
while WithinLimits(AValue) do |
446 |
|
begin |
447 |
< |
for i := 1 to aScale do |
448 |
< |
Scaling := Scaling * 10; |
449 |
< |
FValue := trunc(aValue / Scaling); |
450 |
< |
end |
451 |
< |
else |
303 |
< |
FValue := trunc(aValue); |
304 |
< |
// writeln('Adjusted ',Value,' to ',Result); |
447 |
> |
aValue := aValue * 10; |
448 |
> |
Inc(aScale); |
449 |
> |
end; |
450 |
> |
i := Round(aValue); |
451 |
> |
Create(i,-aScale); |
452 |
|
end; |
453 |
|
|
454 |
< |
constructor TFBNumeric.Create(aValue: Currency); |
454 |
> |
constructor TFBNumeric.CreateFromCurr(aValue: Currency); |
455 |
|
begin |
456 |
|
inherited Create; |
457 |
|
Move(aValue,FValue,sizeof(Int64)); |
458 |
|
FScale := -4; |
459 |
|
end; |
460 |
|
|
461 |
< |
constructor TFBNumeric.Create(aValue: TBCD); |
461 |
> |
constructor TFBNumeric.CreateFromBCD(aValue: TBCD); |
462 |
|
var ScaledBCD: TBCD; |
463 |
|
begin |
464 |
|
inherited Create; |
477 |
|
Result := FScale; |
478 |
|
end; |
479 |
|
|
480 |
< |
function TFBNumeric.clone(aNewScale: integer): IFBNumeric; |
480 |
> |
function TFBNumeric.AdjustScaleTo(aNewScale: integer): IFBNumeric; |
481 |
|
begin |
482 |
< |
Result := TFBNumeric.Create(Round(FValue * IntPower(10,FScale-aNewScale)),aNewScale); |
482 |
> |
if FScale = aNewScale then |
483 |
> |
Result := TFBNumeric.Create(FValue,FScale) |
484 |
> |
else |
485 |
> |
Result := TFBNumeric.Create(AdjustScale(self,aNewScale),aNewScale); |
486 |
|
end; |
487 |
|
|
488 |
|
function TFBNumeric.getAsString: AnsiString; |
531 |
|
begin |
532 |
|
if FScale <> -4 then |
533 |
|
begin |
534 |
< |
value := clone(-4).GetRawValue; |
534 |
> |
value := AdjustScaleTo(-4).GetRawValue; |
535 |
|
Move(value,Result,sizeof(Currency)); |
536 |
< |
end |
536 |
> |
end |
537 |
|
else |
538 |
|
Move(FValue,Result,sizeof(Currency)); |
539 |
|
end; |
540 |
|
|
391 |
– |
(*var |
392 |
– |
Scaling : Int64; |
393 |
– |
i : Integer; |
394 |
– |
FractionText, PadText, CurrText: AnsiString; |
395 |
– |
begin |
396 |
– |
Result := 0; |
397 |
– |
Scaling := 1; |
398 |
– |
PadText := ''; |
399 |
– |
if FScale > 0 then |
400 |
– |
begin |
401 |
– |
for i := 1 to FScale do |
402 |
– |
Scaling := Scaling * 10; |
403 |
– |
result := FValue * Scaling; |
404 |
– |
end |
405 |
– |
else |
406 |
– |
if FScale < 0 then |
407 |
– |
begin |
408 |
– |
for i := -1 downto FScale do |
409 |
– |
Scaling := Scaling * 10; |
410 |
– |
FractionText := IntToStr(abs(FValue mod Scaling)); |
411 |
– |
for i := Length(FractionText) to -FScale -1 do |
412 |
– |
PadText := '0' + PadText; |
413 |
– |
{$IF declared(DefaultFormatSettings)} |
414 |
– |
with DefaultFormatSettings do |
415 |
– |
{$ELSE} |
416 |
– |
{$IF declared(FormatSettings)} |
417 |
– |
with FormatSettings do |
418 |
– |
{$IFEND} |
419 |
– |
{$IFEND} |
420 |
– |
if FValue < 0 then |
421 |
– |
CurrText := '-' + IntToStr(Abs(FValue div Scaling)) + DecimalSeparator + PadText + FractionText |
422 |
– |
else |
423 |
– |
CurrText := IntToStr(Abs(FValue div Scaling)) + DecimalSeparator + PadText + FractionText; |
424 |
– |
try |
425 |
– |
result := StrToCurr(CurrText); |
426 |
– |
except |
427 |
– |
on E: Exception do |
428 |
– |
IBError(ibxeInvalidDataConversion, [nil]); |
429 |
– |
end; |
430 |
– |
end |
431 |
– |
else |
432 |
– |
result := FValue; |
433 |
– |
end; *) |
434 |
– |
|
541 |
|
function TFBNumeric.getAsBCD: TBCD; |
542 |
|
begin |
543 |
|
Result := DoubleToBCD(getAsDouble); |