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 380 by tony, Mon Jan 10 10:08:03 2022 UTC vs.
Revision 381 by tony, Sat Jan 15 00:06:22 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 229 | Line 253 | begin
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
# Line 263 | Line 405 | 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;
# Line 330 | Line 466 | begin
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;
# Line 384 | Line 520 | var value: int64;
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);

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines