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:	379
Committed:	Mon Jan 10 10:08:03 2022 UTC (2 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	11660 byte(s)
Log Message:	set line ending property
#	Content
1	(*
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	if FScale = aNewScale then
336	Result := TFBNumeric.Create(FValue,FScale)
337	else
338	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	end
390	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