ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBNumeric.pas
(Generate patch)

Comparing ibx/branches/udr/client/FBNumeric.pas (file contents):
Revision 375 by tony, Sun Jan 9 23:42:58 2022 UTC vs.
Revision 383 by tony, Sat Jan 15 16:02:25 2022 UTC

# Line 52 | Line 52 | uses
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  
# Line 80 | Line 105 | type
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;
# Line 102 | Line 126 | type
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;
# Line 207 | Line 231 | begin
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;
# Line 229 | Line 255 | begin
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
# Line 263 | Line 416 | 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;
# Line 330 | Line 477 | begin
477   Result := FScale;
478   end;
479  
480 < function TFBNumeric.clone(aNewScale: integer): IFBNumeric;
480 > function TFBNumeric.AdjustScaleTo(aNewScale: integer): IFBNumeric;
481   begin
482   if FScale = aNewScale then
483     Result := TFBNumeric.Create(FValue,FScale)
484   else
485 <  Result := TFBNumeric.Create(Round(FValue * IntPower(10,FScale-aNewScale)),aNewScale);
485 >  Result := TFBNumeric.Create(AdjustScale(self,aNewScale),aNewScale);
486   end;
487  
488   function TFBNumeric.getAsString: AnsiString;
# Line 384 | Line 531 | var value: int64;
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
537    else
538      Move(FValue,Result,sizeof(Currency));
539   end;
540  
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
541   function TFBNumeric.getAsBCD: TBCD;
542   begin
543    Result := DoubleToBCD(getAsDouble);

Comparing ibx/branches/udr/client/FBNumeric.pas (property svn:eol-style):
Revision 375 by tony, Sun Jan 9 23:42:58 2022 UTC vs.
Revision 383 by tony, Sat Jan 15 16:02:25 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines