Browse Source

rtl: system val integers support for hexnumbers

mattias 6 years ago
parent
commit
1f3e008591
1 changed files with 16 additions and 71 deletions
  1. 16 71
      packages/rtl/system.pas

+ 16 - 71
packages/rtl/system.pas

@@ -476,11 +476,9 @@ end;
 
 
 function Number(S: String): Double; external name 'Number';
 function Number(S: String): Double; external name 'Number';
 
 
-procedure val(const S: String; out NI : NativeInt; out Code: Integer);
-
+function valint(const S: String; MinVal, MaxVal: NativeInt; out Code: Integer): NativeInt;
 var
 var
-  x : double;
-
+  x: double;
 begin
 begin
   Code:=0;
   Code:=0;
   x:=Number(S);
   x:=Number(S);
@@ -495,8 +493,15 @@ begin
     end;
     end;
   if isNaN(x) or (X<>Int(X)) then
   if isNaN(x) or (X<>Int(X)) then
     Code:=1
     Code:=1
+  else if (x<MinVal) or (x>MaxVal) then
+    Code:=2
   else
   else
-    NI:=Trunc(x);
+    Result:=Trunc(x);
+end;
+
+procedure val(const S: String; out NI : NativeInt; out Code: Integer);
+begin
+  NI:=valint(S,low(NI),high(NI),Code);
 end;
 end;
 
 
 procedure val(const S: String; out NI: NativeUInt; out Code: Integer);
 procedure val(const S: String; out NI: NativeUInt; out Code: Integer);
@@ -512,96 +517,36 @@ begin
 end;
 end;
 
 
 procedure val(const S: String; out SI : ShortInt; out Code: Integer);
 procedure val(const S: String; out SI : ShortInt; out Code: Integer);
-var
-  X:Double;
 begin
 begin
-  Code:=0;
-  x:=Number(S);
-  if isNaN(x) or (X<>Int(X)) then
-    Code:=1
-  else if (x<MinShortInt) or (x>MaxShortInt) then
-    Code:=2
-  else
-    SI:=Trunc(x);
+  SI:=valint(S,low(SI),high(SI),Code);
 end;
 end;
 
 
 procedure val(const S: String; out SI: smallint; out Code: Integer);
 procedure val(const S: String; out SI: smallint; out Code: Integer);
-
-var
-  x: double;
 begin
 begin
-  Code:=0;
-  x:=Number(S);
-  if isNaN(x) or (X<>Int(X)) then
-    Code:=1
-  else if (x<MinSmallint) or (x>MaxSmallint) then
-    Code:=2
-  else
-    SI:=Trunc(x);
+  SI:=valint(S,low(SI),high(SI),Code);
 end;
 end;
 
 
 procedure val(const S: String; out C: Cardinal; out Code: Integer);
 procedure val(const S: String; out C: Cardinal; out Code: Integer);
-
-var
-  x: double;
 begin
 begin
-  Code:=0;
-  x:=Number(S);
-  if isNaN(x) or (X<>Int(X)) then
-    Code:=1
-  else if (x<0) or (x>MaxCardinal) then
-    Code:=2
-  else
-    C:=trunc(x);
+  C:=valint(S,low(C),high(C),Code);
 end;
 end;
 
 
 procedure val(const S: String; out B: Byte; out Code: Integer);
 procedure val(const S: String; out B: Byte; out Code: Integer);
-
-var
-  x: double;
 begin
 begin
-  Code:=0;
-  x:=Number(S);
-  if isNaN(x) or (X<>Int(X)) then
-    Code:=1
-  else if (x<0) or (x>MaxByte) then
-    Code:=2
-  else
-    B:=Trunc(x);
+  B:=valint(S,low(B),high(B),Code);
 end;
 end;
 
 
-
 procedure val(const S: String; out W: word; out Code: Integer);
 procedure val(const S: String; out W: word; out Code: Integer);
-
-var
-  x: double;
 begin
 begin
-  Code:=0;
-  x:=Number(S);
-  if isNaN(x) then
-    Code:=1
-  else if (x<0) or (x>MaxWord) then
-    Code:=2
-  else
-    W:=Trunc(x);
+  W:=valint(S,low(W),high(W),Code);
 end;
 end;
 
 
 procedure val(const S : String; out I : integer; out Code : Integer);
 procedure val(const S : String; out I : integer; out Code : Integer);
-var
-  x: double;
 begin
 begin
-  Code:=0;
-  x:=Number(S);
-  if isNaN(x) then
-    Code:=1
-  else if x>MaxInt then
-    Code:=2
-  else
-    I:=Trunc(x);
+  I:=valint(S,low(I),high(I),Code);
 end;
 end;
 
 
 procedure val(const S : String; out d : double; out Code : Integer);
 procedure val(const S : String; out d : double; out Code : Integer);
-
 Var
 Var
   x: double;
   x: double;
 begin
 begin