'+------------------------------------------------------------------------------------------+
'|		Header :evaluation of parameters if any
'|    DisplayCheck:|Il1 are Alt-0124, Big i, Small L, One ���᎙��=������ܱ�
Const Author="NumericError.Bas v0.185b �2007 by ytwinky, MD"
'|           (Shortcut: none)
'|
'|    Purpose:Checks if a string may be converted to a number(Hex, Bin, Oct, Real)
'|    Source :you just read it..
'+------------------------------------------------------------------------------------------+
Declare Function NumericError(byRef s As String, byVal comma As String=",") As Integer
Var s="", NumErr As Integer=0, c=""
c=Author &!"\nTested with FB 0.185b, using FBEdit\n"
c+=!"Use FB-Syntax: &h for hex, &b for bin, &o for oct, no prefix for dec\n"
c+=!"MaxStringLength for hex=8+2, bin=32+2, oct=11+2, see Help for MaxRange\n"
c+=!"Negative returnvalues ==> string too long(-999 means: out of range)\n"
c+=!"Prefixes have to be in the first position of the string\n"
c+=!"'-' is allowed only as the first character or behind 'e'\n"
c=!"(You do not need '-' for hex, bin or oct..)\n"
c+=!"'.' is allowed only once for reals, of course not for the others\n"
Print c &"Letters are always converted to ucase(..byRef..).."
Do
  Do
    If NumErr Then
      c=Hex(Color, 2)
      Print "NumericError in " &Left(s, NumErr-1);
      Color Val("&H" &Chr(c[0])), Val("&H" &Chr(c[1]))
      Print Chr(s[NumErr-1]);
      Color Val("&H" &Chr(c[1])), Val("&H" &Chr(c[0]))
      Print Mid(s, NumErr+1) &" at position " &NumErr
    End If
    Line Input"Enter any number you like:", s
    NumErr=NumericError(s)
  Loop Until Not NumErr
  If s<>"" Then
    Print "Well done, " &s &" seems to be numeric.."
    Print "Val:" &s &" is "&Val(s)
  End If
Loop Until s=""
GetKey
End

Function NumericError(byRef s As String, byVal comma As String=",") As Integer 'will return the errorposition, 0 means no error
  Const SysChar="0123456789ABCDEF" '
  Dim As Integer NumSys, i, PosE, OneEIsOk, OneDotIsOk
  Dim As String Sys
  s=Trim(UCase(Trim(s)), Any "+") 'remove leading '+', if any..
  If s[0]=38 Then 'check if Hex, Bin, Oct, &=38
    If Len(s)>2 Then 'PrefixStart is here..
      Sys=Chr(s[1])
      NumSys=-2*(Sys="B")-8*(Sys="O")-16*(Sys="H")
      If NumSys=0 Then Return 2 'no valid prefix
      Print "NumSys=" &NumSys
      For i=3 To Len(s) 'skip the prefix
        If Instr(Left(SysChar, NumSys), Chr(s[i-1]))=0 Then Return i
      Next 'still here => no error..
      If i-3>(-32*(Sys="B")-11*(Sys="O")-8*(Sys="H")) Then Return 1-i
    Else '..no valid prefix found
      Return 2
    End If ' prefixevaluation ends..
  Else 'maybe real(remember integers are part of reals..)
    PosE=Instr(s, "E")
    For i=1 To Len(s) '..and now check the whole string..
      Select Case Chr(s[i-1])
        Case "+" 'skip it, if first behind 'E'
          If i<>(PosE+1) Then Return i
        Case "-"
          If i<>1 And i<>(PosE+1) Then Return i
        Case "E"
          If OneEIsOk Then Return i
          OneEIsOk=1
        Case comma
          If OneEIsOk Or OneDotIsOk Then Return i
          Mid(s, i, 1)="."
          OneDotIsOk=1
        Case "."
          If OneEIsOk Or OneDotIsOk Then Return i
          OneDotIsOk=1
        Case Else
          If Instr(Left(SysChar, 10), Chr(s[i-1]))=0 Then Return i 'if no decimal value return error
      End Select
    Next 'still here => no error..
    If PosE Then ' -2.2E-308 to +1.7E+308, see help for details
      If Abs(Val(Mid(s, PosE+1)))>308 Then Return -999
      If Abs(Val(Mid(s, PosE+1)))=308 Then
        If Val(Left(s, PosE-1))<-2.2 Or Val(Left(s, PosE-1))>1.7 Then Return -999
      End If
    End If
  End If
	Return IIf(Chr(s[Len(s)-1])="E" And NumSys<>16, Len(s), 0)
End Function