ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/udr/client/FBNumeric.pas

Comparing ibx/branches/udr/client/FBNumeric.pas (file contents):
Revision 379 by tony, Mon Jan 10 10:08:03 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);

Diff Legend

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