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 371 by tony, Wed Jan 5 15:21:22 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	<	Result := TFBNumeric.Create(Round(FValue * IntPower(10,FScale-aNewScale)),aNewScale);
471	>	if FScale = aNewScale then
472	>	Result := TFBNumeric.Create(FValue,FScale)
473	>	else
474	>	Result := TFBNumeric.Create(AdjustScale(self,aNewScale),aNewScale);
475		end;
476
477		function TFBNumeric.getAsString: AnsiString;
#	Line 381 | 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
525	>	end
526		else
527		Move(FValue,Result,sizeof(Currency));
528		end;
529
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	–
530		function TFBNumeric.getAsBCD: TBCD;
531		begin
532		Result := DoubleToBCD(getAsDouble);

Comparing ibx/branches/udr/client/FBNumeric.pas (property svn:eol-style):
Revision 371 by tony, Wed Jan 5 15:21:22 2022 UTC vs.
Revision 381 by tony, Sat Jan 15 00:06:22 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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