udr/client/FBNumeric.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API. Although predominantly
 *  a new development they include source code taken from IBX and may be
 *  considered a derived product. This software thus also includes the copyright
 *  notice and license conditions from IBX.
 *
 *  Except for those parts dervied from IBX, contents of this file are subject
 *  to the Initial Developer's Public License Version 1.0 (the "License"); you
 *  may not use this file except in compliance with the License. You may obtain a
 *  copy of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2021 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FBNumeric;

{$IFDEF MSWINDOWS}
{$DEFINE WINDOWS}
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage UTF8}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, IB, FBActivityMonitor, FmtBCD;

{ The IFBNumeric interface is a managed type to hold a fixed point integer
  as a 64-bit signed integer plus a scale factor. i.e. the scale factor is
  the base 10 exponent in

    Fixed Point Value = <64-bit signed integer> * 10^<scale factor>

}

function NewNumeric(aValue: AnsiString): IFBNumeric; overload;
function NewNumeric(aValue: double; aScale: integer): IFBNumeric; overload;
function NewNumeric(aValue: TBCD): IFBNumeric; overload;
function NewNumeric(aValue: currency): IFBNumeric; overload;
function NewNumeric(aValue: Int64): IFBNumeric; overload;
function NumericFromRawValues(aValue: Int64; aScale: integer): IFBNumeric;

function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
function NumericToDouble(aValue: Int64; aScale: integer): double;

function SafeSmallInt(aValue: Int64): Smallint;
function SafeInteger(aValue: Int64): integer;


implementation

uses IBUtils, FBMessages, Math;

type

  { TIBNumeric }

  { TFBNumeric }

  TFBNumeric = class(TFBInterfacedObject,IFBNumeric)
  private
    FValue: Int64;
    FScale: integer;
//    function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
  public
    constructor Create(aValue: Int64; aScale: integer); overload;
    constructor Create(aValue: Int64); overload;
    constructor Create(aValue: AnsiString); overload;
    constructor Create(aValue: double; aScale: integer); overload;
    constructor Create(aValue: Currency); overload;
    constructor Create(aValue: TBCD); overload;
  public
    {IFBNumeric}
    function getRawValue: Int64;
    function getScale: integer;
    function clone(aNewScale: integer): IFBNumeric;
    function getAsString: AnsiString;
    function getAsDouble: double;
    function getAsCurrency: Currency;
    function getAsBCD: TBCD;
    function getAsInt64: Int64; {scaled}
    function getAsInteger: integer; {scaled - may be truncated}
    function getAsSmallInt: SmallInt; {scaled - may be truncated}
  end;

function NewNumeric(aValue: AnsiString): IFBNumeric;
begin
  Result :=  TFBNumeric.Create(aValue);
end;

function NewNumeric(aValue: double; aScale: integer): IFBNumeric;
begin
  Result :=  TFBNumeric.Create(aValue,aScale);
end;

function NewNumeric(aValue: TBCD): IFBNumeric;
begin
  Result :=  TFBNumeric.Create(aValue);
end;

function NewNumeric(aValue: currency): IFBNumeric;
begin
  Result :=  TFBNumeric.Create(aValue);
end;

function NewNumeric(aValue: Int64): IFBNumeric;
begin
  Result :=  TFBNumeric.Create(aValue);
end;

function NumericFromRawValues(aValue: Int64; aScale: integer): IFBNumeric;
begin
  Result := TFBNumeric.Create(aValue,aScale);
end;

function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
var i: integer;
    ds: integer;
    exponent: integer;
begin
  Result := false;
  ds := 0;
  exponent := 0;
  S := Trim(S);
  Value := 0;
  scale := 0;
  if Length(S) = 0 then
    Exit;
  {$IF declared(DefaultFormatSettings)}
  with DefaultFormatSettings do
  {$ELSE}
  {$IF declared(FormatSettings)}
  with FormatSettings do
  {$IFEND}
  {$IFEND}
  begin
    for i := length(S) downto 1 do
    begin
      if S[i] = AnsiChar(DecimalSeparator) then
      begin
          if ds <> 0 then Exit; {only one allowed}
          ds := i;
          dec(exponent);
          system.Delete(S,i,1);
      end
      else
      if S[i] in ['+','-'] then
      begin
       if (i > 1) and not (S[i-1] in ['e','E']) then
          Exit; {malformed}
      end
      else
      if S[i] in ['e','E'] then {scientific notation}
      begin
        if ds <> 0 then Exit; {not permitted in exponent}
        if exponent <> 0 then Exit; {only one allowed}
        exponent := i;
      end
      else
      if not (S[i] in ['0'..'9']) then
      {Note: ThousandSeparator not allowed by Delphi specs}
          Exit; {bad character}
    end;

    if exponent > 0 then
    begin
      Result := TryStrToInt(system.copy(S,exponent+1,maxint),Scale);
      if Result then
      begin
        {adjust scale for decimal point}
        if ds <> 0 then
          Scale := Scale - (exponent - ds);
        Result := TryStrToInt64(system.copy(S,1,exponent-1),Value);
      end;
    end
    else
    begin
      if ds > 0 then
      begin
        {remove trailing zeroes}
        while (ds < length(S)) and (S[length(S)] = '0') do {no need to check length as ds > 0}
          system.delete(S,Length(S),1);
        scale := ds - Length(S) - 1;
      end;
      Result := TryStrToInt64(S,Value);
    end;
  end;
end;

function NumericToDouble(aValue: Int64; aScale: integer): double;
begin
  Result := aValue * IntPower(10,aScale);
end;

function SafeSmallInt(aValue: Int64): Smallint;
begin
  if aValue > High(smallint) then
    IBError(ibxeIntegerOverflow,[]);
  if aValue < Low(smallint) then
    IBError(ibxIntegerUnderflow,[]);
  Result := aValue;
end;

function SafeInteger(aValue: Int64): integer;
begin
  if aValue > High(integer) then
    IBError(ibxeIntegerOverflow,[]);
  if aValue < Low(integer) then
    IBError(ibxIntegerUnderflow,[]);
  Result := aValue;
end;

{ TFBNumeric }

(*function TFBNumeric.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
  ): Int64;
var
  Scaling : Int64;
  i : Integer;
begin
  Result := 0;
  Scaling := 1;
  if aScale < 0 then
  begin
    for i := -1 downto aScale do
      Scaling := Scaling * 10;
    result := trunc(Value * Scaling);
  end
  else
  if aScale > 0 then
  begin
    for i := 1 to aScale do
       Scaling := Scaling * 10;
    result := trunc(Value / Scaling);
  end
  else
    result := trunc(Value);
end;*)

constructor TFBNumeric.Create(aValue: Int64; aScale: integer);
begin
  inherited Create;
  FValue := aValue;
  FScale := aScale;
end;

constructor TFBNumeric.Create(aValue: Int64);
begin
  inherited Create;
  FValue := aValue;
  FScale := 0;
end;

constructor TFBNumeric.Create(aValue: AnsiString);
begin
  inherited Create;
  if not TryStrToNumeric(aValue,FValue,FScale) then
    IBError(ibxeInvalidDataConversion,[aValue]);
end;

constructor TFBNumeric.Create(aValue: double; aScale: integer);
var
  Scaling : Int64;
  i : Integer;
begin
  inherited Create;
  FScale := aScale;
  FValue := 0;
  Scaling := 1;
  if aScale < 0 then
  begin
    for i := -1 downto aScale do
      Scaling := Scaling * 10;
    FValue := trunc(aValue * Scaling);
  end
  else
  if aScale > 0 then
  begin
    for i := 1 to aScale do
       Scaling := Scaling * 10;
    FValue := trunc(aValue / Scaling);
  end
  else
    FValue := trunc(aValue);
//  writeln('Adjusted ',Value,' to ',Result);
end;

constructor TFBNumeric.Create(aValue: Currency);
begin
  inherited Create;
  Move(aValue,FValue,sizeof(Int64));
  FScale := -4;
end;

constructor TFBNumeric.Create(aValue: TBCD);
var ScaledBCD: TBCD;
begin
  inherited Create;
  FScale := -BCDScale(aValue);
  BCDMultiply(aValue,Power(10,-FScale),ScaledBCD);
  FValue := BCDToInteger(ScaledBCD,true);
end;

function TFBNumeric.getRawValue: Int64;
begin
  Result := FValue;
end;

function TFBNumeric.getScale: integer;
begin
 Result := FScale;
end;

function TFBNumeric.clone(aNewScale: integer): IFBNumeric;
begin
 if FScale = aNewScale then
   Result := TFBNumeric.Create(FValue,FScale)
 else
  Result := TFBNumeric.Create(Round(FValue * IntPower(10,FScale-aNewScale)),aNewScale);
end;

function TFBNumeric.getAsString: AnsiString;
var Scaling : AnsiString;
    i: Integer;
begin
  Result := IntToStr(FValue);
  Scaling := '';
  if FScale > 0 then
  begin
    for i := 1 to FScale do
      Result := Result + '0';
  end
  else
  if FScale < 0 then
  {$IF declared(DefaultFormatSettings)}
  with DefaultFormatSettings do
  {$ELSE}
  {$IF declared(FormatSettings)}
  with FormatSettings do
  {$IFEND}
  {$IFEND}
  begin
    if Length(Result) > -FScale then
      system.Insert(DecimalSeparator,Result,Length(Result) + FScale+1)
    else
    begin
      Scaling := '0' + DecimalSeparator;
      for i := -1 downto FScale + Length(Result) do
        Scaling := Scaling + '0';
      if FValue < 0 then
        system.insert(Scaling,Result,2)
      else
        Result := Scaling + Result;
    end;
  end;
end;

function TFBNumeric.getAsDouble: double;
begin
  Result := NumericToDouble(FValue,FScale);
end;

function TFBNumeric.getAsCurrency: Currency;
var value: int64;
begin
  if FScale <> -4 then
  begin
    value := clone(-4).GetRawValue;
    Move(value,Result,sizeof(Currency));
  end
  else
    Move(FValue,Result,sizeof(Currency));
end;

(*var
  Scaling : Int64;
  i : Integer;
  FractionText, PadText, CurrText: AnsiString;
begin
  Result := 0;
  Scaling := 1;
  PadText := '';
  if FScale > 0 then
  begin
    for i := 1 to FScale do
      Scaling := Scaling * 10;
    result := FValue * Scaling;
  end
  else
    if FScale < 0 then
    begin
      for i := -1 downto FScale do
        Scaling := Scaling * 10;
      FractionText := IntToStr(abs(FValue mod Scaling));
      for i := Length(FractionText) to -FScale -1 do
        PadText := '0' + PadText;
      {$IF declared(DefaultFormatSettings)}
      with DefaultFormatSettings do
      {$ELSE}
      {$IF declared(FormatSettings)}
      with FormatSettings do
      {$IFEND}
      {$IFEND}
      if FValue < 0 then
        CurrText := '-' + IntToStr(Abs(FValue div Scaling)) + DecimalSeparator + PadText + FractionText
      else
        CurrText := IntToStr(Abs(FValue div Scaling)) + DecimalSeparator + PadText + FractionText;
      try
        result := StrToCurr(CurrText);
      except
        on E: Exception do
          IBError(ibxeInvalidDataConversion, [nil]);
      end;
    end
    else
      result := FValue;
end; *)

function TFBNumeric.getAsBCD: TBCD;
begin
  Result := DoubleToBCD(getAsDouble);
end;

function TFBNumeric.getAsInt64: Int64;
var
  Scaling : Int64;
  i: Integer;
  Val: Int64;
begin
  Scaling := 1;
  Val := FValue;
  if FScale > 0 then begin
    for i := 1 to FScale do Scaling := Scaling * 10;
    result := Val * Scaling;
  end else if FScale < 0 then begin
    for i := -1 downto FScale do Scaling := Scaling * 10;
    result := Val div Scaling;
  end else
    result := Val;
end;

function TFBNumeric.getAsInteger: integer;
begin
  Result := SafeInteger(getAsInt64);
end;

function TFBNumeric.getAsSmallInt: SmallInt;
begin
  Result := SafeSmallInt(getAsInt64);
end;

end.

Revision:	375
Committed:	Sun Jan 9 23:42:58 2022 UTC (2 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	11660 byte(s)
Log Message:	Fixes
#	User	Rev	Content
1	tony	371	(*
2			* Firebird Interface (fbintf). The fbintf components provide a set of
3			* Pascal language bindings for the Firebird API. Although predominantly
4			* a new development they include source code taken from IBX and may be
5			* considered a derived product. This software thus also includes the copyright
6			* notice and license conditions from IBX.
7			*
8			* Except for those parts dervied from IBX, contents of this file are subject
9			* to the Initial Developer's Public License Version 1.0 (the "License"); you
10			* may not use this file except in compliance with the License. You may obtain a
11			* copy of the License here:
12			*
13			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
14			*
15			* Software distributed under the License is distributed on an "AS
16			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17			* implied. See the License for the specific language governing rights
18			* and limitations under the License.
19			*
20			* The Initial Developer of the Original Code is Tony Whyman.
21			*
22			* The Original Code is (C) 2021 Tony Whyman, MWA Software
23			* (http://www.mwasoftware.co.uk).
24			*
25			* All Rights Reserved.
26			*
27			* Contributor(s): ______________________________________.
28			*
29			*)
30			unit FBNumeric;
31
32			{$IFDEF MSWINDOWS}
33			{$DEFINE WINDOWS}
34			{$ENDIF}
35
36			{$IFDEF FPC}
37			{$mode delphi}
38			{$codepage UTF8}
39			{$interfaces COM}
40			{$ENDIF}
41
42			interface
43
44			uses
45			Classes, SysUtils, IB, FBActivityMonitor, FmtBCD;
46
47			{ The IFBNumeric interface is a managed type to hold a fixed point integer
48			as a 64-bit signed integer plus a scale factor. i.e. the scale factor is
49			the base 10 exponent in
50
51			Fixed Point Value = <64-bit signed integer> * 10^<scale factor>
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;
60			function NumericFromRawValues(aValue: Int64; aScale: integer): IFBNumeric;
61
62			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
69			implementation
70
71			uses IBUtils, FBMessages, Math;
72
73			type
74
75			{ TIBNumeric }
76
77			{ TFBNumeric }
78
79			TFBNumeric = class(TFBInterfacedObject,IFBNumeric)
80			private
81			FValue: Int64;
82			FScale: integer;
83			// function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
84			public
85			constructor Create(aValue: Int64; aScale: integer); overload;
86			constructor Create(aValue: Int64); overload;
87			constructor Create(aValue: AnsiString); overload;
88			constructor Create(aValue: double; aScale: integer); overload;
89			constructor Create(aValue: Currency); overload;
90			constructor Create(aValue: TBCD); overload;
91			public
92			{IFBNumeric}
93			function getRawValue: Int64;
94			function getScale: integer;
95			function clone(aNewScale: integer): IFBNumeric;
96			function getAsString: AnsiString;
97			function getAsDouble: double;
98			function getAsCurrency: Currency;
99			function getAsBCD: TBCD;
100			function getAsInt64: Int64; {scaled}
101			function getAsInteger: integer; {scaled - may be truncated}
102			function getAsSmallInt: SmallInt; {scaled - may be truncated}
103			end;
104
105			function NewNumeric(aValue: AnsiString): IFBNumeric;
106			begin
107			Result := TFBNumeric.Create(aValue);
108			end;
109
110			function NewNumeric(aValue: double; aScale: integer): IFBNumeric;
111			begin
112			Result := TFBNumeric.Create(aValue,aScale);
113			end;
114
115			function NewNumeric(aValue: TBCD): IFBNumeric;
116			begin
117			Result := TFBNumeric.Create(aValue);
118			end;
119
120			function NewNumeric(aValue: currency): IFBNumeric;
121			begin
122			Result := TFBNumeric.Create(aValue);
123			end;
124
125			function NewNumeric(aValue: Int64): IFBNumeric;
126			begin
127			Result := TFBNumeric.Create(aValue);
128			end;
129
130			function NumericFromRawValues(aValue: Int64; aScale: integer): IFBNumeric;
131			begin
132			Result := TFBNumeric.Create(aValue,aScale);
133			end;
134
135			function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
136			var i: integer;
137			ds: integer;
138			exponent: integer;
139			begin
140			Result := false;
141			ds := 0;
142			exponent := 0;
143			S := Trim(S);
144			Value := 0;
145			scale := 0;
146			if Length(S) = 0 then
147			Exit;
148			{$IF declared(DefaultFormatSettings)}
149			with DefaultFormatSettings do
150			{$ELSE}
151			{$IF declared(FormatSettings)}
152			with FormatSettings do
153			{$IFEND}
154			{$IFEND}
155			begin
156			for i := length(S) downto 1 do
157			begin
158			if S[i] = AnsiChar(DecimalSeparator) then
159			begin
160			if ds <> 0 then Exit; {only one allowed}
161			ds := i;
162			dec(exponent);
163			system.Delete(S,i,1);
164			end
165			else
166			if S[i] in ['+','-'] then
167			begin
168			if (i > 1) and not (S[i-1] in ['e','E']) then
169			Exit; {malformed}
170			end
171			else
172			if S[i] in ['e','E'] then {scientific notation}
173			begin
174			if ds <> 0 then Exit; {not permitted in exponent}
175			if exponent <> 0 then Exit; {only one allowed}
176			exponent := i;
177			end
178			else
179			if not (S[i] in ['0'..'9']) then
180			{Note: ThousandSeparator not allowed by Delphi specs}
181			Exit; {bad character}
182			end;
183
184			if exponent > 0 then
185			begin
186			Result := TryStrToInt(system.copy(S,exponent+1,maxint),Scale);
187			if Result then
188			begin
189			{adjust scale for decimal point}
190			if ds <> 0 then
191			Scale := Scale - (exponent - ds);
192			Result := TryStrToInt64(system.copy(S,1,exponent-1),Value);
193			end;
194			end
195			else
196			begin
197			if ds > 0 then
198			begin
199			{remove trailing zeroes}
200			while (ds < length(S)) and (S[length(S)] = '0') do {no need to check length as ds > 0}
201			system.delete(S,Length(S),1);
202			scale := ds - Length(S) - 1;
203			end;
204			Result := TryStrToInt64(S,Value);
205			end;
206			end;
207			end;
208
209			function NumericToDouble(aValue: Int64; aScale: integer): double;
210			begin
211			Result := aValue * IntPower(10,aScale);
212			end;
213
214			function SafeSmallInt(aValue: Int64): Smallint;
215			begin
216			if aValue > High(smallint) then
217			IBError(ibxeIntegerOverflow,[]);
218			if aValue < Low(smallint) then
219			IBError(ibxIntegerUnderflow,[]);
220			Result := aValue;
221			end;
222
223			function SafeInteger(aValue: Int64): integer;
224			begin
225			if aValue > High(integer) then
226			IBError(ibxeIntegerOverflow,[]);
227			if aValue < Low(integer) then
228			IBError(ibxIntegerUnderflow,[]);
229			Result := aValue;
230			end;
231
232			{ TFBNumeric }
233
234			(*function TFBNumeric.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
235			): Int64;
236			var
237			Scaling : Int64;
238			i : Integer;
239			begin
240			Result := 0;
241			Scaling := 1;
242			if aScale < 0 then
243			begin
244			for i := -1 downto aScale do
245			Scaling := Scaling * 10;
246			result := trunc(Value * Scaling);
247			end
248			else
249			if aScale > 0 then
250			begin
251			for i := 1 to aScale do
252			Scaling := Scaling * 10;
253			result := trunc(Value / Scaling);
254			end
255			else
256			result := trunc(Value);
257			end;*)
258
259			constructor TFBNumeric.Create(aValue: Int64; aScale: integer);
260			begin
261			inherited Create;
262			FValue := aValue;
263			FScale := aScale;
264			end;
265
266			constructor TFBNumeric.Create(aValue: Int64);
267			begin
268			inherited Create;
269			FValue := aValue;
270			FScale := 0;
271			end;
272
273			constructor TFBNumeric.Create(aValue: AnsiString);
274			begin
275			inherited Create;
276			if not TryStrToNumeric(aValue,FValue,FScale) then
277			IBError(ibxeInvalidDataConversion,[aValue]);
278			end;
279
280			constructor TFBNumeric.Create(aValue: double; aScale: integer);
281			var
282			Scaling : Int64;
283			i : Integer;
284			begin
285			inherited Create;
286			FScale := aScale;
287			FValue := 0;
288			Scaling := 1;
289			if aScale < 0 then
290			begin
291			for i := -1 downto aScale do
292			Scaling := Scaling * 10;
293			FValue := trunc(aValue * Scaling);
294			end
295			else
296			if aScale > 0 then
297			begin
298			for i := 1 to aScale do
299			Scaling := Scaling * 10;
300			FValue := trunc(aValue / Scaling);
301			end
302			else
303			FValue := trunc(aValue);
304			// writeln('Adjusted ',Value,' to ',Result);
305			end;
306
307			constructor TFBNumeric.Create(aValue: Currency);
308			begin
309			inherited Create;
310			Move(aValue,FValue,sizeof(Int64));
311			FScale := -4;
312			end;
313
314			constructor TFBNumeric.Create(aValue: TBCD);
315			var ScaledBCD: TBCD;
316			begin
317			inherited Create;
318			FScale := -BCDScale(aValue);
319			BCDMultiply(aValue,Power(10,-FScale),ScaledBCD);
320			FValue := BCDToInteger(ScaledBCD,true);
321			end;
322
323			function TFBNumeric.getRawValue: Int64;
324			begin
325			Result := FValue;
326			end;
327
328			function TFBNumeric.getScale: integer;
329			begin
330			Result := FScale;
331			end;
332
333			function TFBNumeric.clone(aNewScale: integer): IFBNumeric;
334			begin
335	tony	375	if FScale = aNewScale then
336			Result := TFBNumeric.Create(FValue,FScale)
337			else
338	tony	371	Result := TFBNumeric.Create(Round(FValue * IntPower(10,FScale-aNewScale)),aNewScale);
339			end;
340
341			function TFBNumeric.getAsString: AnsiString;
342			var Scaling : AnsiString;
343			i: Integer;
344			begin
345			Result := IntToStr(FValue);
346			Scaling := '';
347			if FScale > 0 then
348			begin
349			for i := 1 to FScale do
350			Result := Result + '0';
351			end
352			else
353			if FScale < 0 then
354			{$IF declared(DefaultFormatSettings)}
355			with DefaultFormatSettings do
356			{$ELSE}
357			{$IF declared(FormatSettings)}
358			with FormatSettings do
359			{$IFEND}
360			{$IFEND}
361			begin
362			if Length(Result) > -FScale then
363			system.Insert(DecimalSeparator,Result,Length(Result) + FScale+1)
364			else
365			begin
366			Scaling := '0' + DecimalSeparator;
367			for i := -1 downto FScale + Length(Result) do
368			Scaling := Scaling + '0';
369			if FValue < 0 then
370			system.insert(Scaling,Result,2)
371			else
372			Result := Scaling + Result;
373			end;
374			end;
375			end;
376
377			function TFBNumeric.getAsDouble: double;
378			begin
379			Result := NumericToDouble(FValue,FScale);
380			end;
381
382			function TFBNumeric.getAsCurrency: Currency;
383			var value: int64;
384			begin
385			if FScale <> -4 then
386			begin
387			value := clone(-4).GetRawValue;
388			Move(value,Result,sizeof(Currency));
389	tony	375	end
390	tony	371	else
391			Move(FValue,Result,sizeof(Currency));
392			end;
393
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
438			function TFBNumeric.getAsBCD: TBCD;
439			begin
440			Result := DoubleToBCD(getAsDouble);
441			end;
442
443			function TFBNumeric.getAsInt64: Int64;
444			var
445			Scaling : Int64;
446			i: Integer;
447			Val: Int64;
448			begin
449			Scaling := 1;
450			Val := FValue;
451			if FScale > 0 then begin
452			for i := 1 to FScale do Scaling := Scaling * 10;
453			result := Val * Scaling;
454			end else if FScale < 0 then begin
455			for i := -1 downto FScale do Scaling := Scaling * 10;
456			result := Val div Scaling;
457			end else
458			result := Val;
459			end;
460
461			function TFBNumeric.getAsInteger: integer;
462			begin
463			Result := SafeInteger(getAsInt64);
464			end;
465
466			function TFBNumeric.getAsSmallInt: SmallInt;
467			begin
468			Result := SafeSmallInt(getAsInt64);
469			end;
470
471			end.
472