Code-Beispiel

Zahl(en) aus STRING-Variable lesen

Lizenz:	Erster Autor:	Letzte Bearbeitung:
GPLv3	TJF	03.04.2012

Dieses Code-Beispiel betrifft eine Funktion, die einen Zahlenwert aus einem STRING liest. Sie arbeitet ähnlich wie die FB-Funktion "VAL" und liefert den Zahlenwert als DOUBLE-Variable.

Das Code-Beispiel bietet jedoch folgende Zusatzfunktionen:

Alle Zeichen vor einer Zahl werden übersprungen.
Das Ende der Zahl wird gemeldet (Zeiger auf erstes Zeichen nach der Zahl, oder NULL am STRING-Ende).
Es werden Nachkommastellen verarbeit, sowohl in Dezimalzahlen als auch in Binär-, Oktal- und Hexadecimalzahlen (Trenner = ".").
Es werden Zahlenformate im FreeBasic- oder im C-Stil verarbeit.
Durch mehrfachen Aufruf können alle Zahlen nacheinander aus einem STRING gelesen werden (vgl. MACRO 'TEST').

Der Quelltext (inklusiv einiger Tests):

' This is file get_value.bas

' A function to read numbers from a STRING

'

' Licence: GPLv3

' (C) 2012 Thomas[ dot ]Freiherr[ at ]gmx[ dot ]net



#DEFINE C_ALL ".0123456789DEdeABCFabcf"

#DEFINE D_ALL {0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 13, 14, 13, 14, 10, 11, 12, 15, 10, 11, 12, 15}

#DEFINE C_DECI 10



FUNCTION get_value(BYREF T AS UBYTE PTR, BYVAL C AS INTEGER = 0) AS DOUBLE

  STATIC AS STRING*23 s = C_ALL

  STATIC AS UBYTE z(...) = D_ALL

  STATIC AS INTEGER a, e, b, x, y, d, f, v

  STATIC AS UBYTE PTR n

  STATIC AS DOUBLE r



  r = 0.0 : v = 1

  WHILE v '                                    search for a valid number

    a = 0 : x = 0 : y = 0 : d = 1 : f = 0

    DO

      IF 0 = *T THEN T = 0 : RETURN 0.0 '  stop at the end of the STRING

      IF *T = ASC("-") THEN n = T : T += 1 ELSE n = 0

      IF C THEN '                                    find C style values

        SELECT CASE AS CONST *T

        CASE ASC(".") : T += 1 : b = 10 : e = 14 : d = -1 : a = 1 : EXIT DO

        CASE ASC("0") : T += 1

          IF *T = ASC(".") THEN v = 0 : T += 1 : b = 10 : e = 14 : d = -1 : a = 1 : EXIT DO

          IF *T = ASC("x") THEN T += 1 : b = 16 : e = 22 : EXIT DO

          v = 0 : b = 8 : e = 8 : EXIT DO

        CASE ASC("1") TO ASC("9") : b = 10 : e = 14 : EXIT DO

        END SELECT

      ELSE '                                        find FB style values

        SELECT CASE AS CONST *T

        CASE ASC(".")    : T += 1 : b = 10 : e = 14 : d = -1 : a = 1 : EXIT DO

        CASE ASC("0") TO ASC("9") : b = 10 : e = 14 : EXIT DO

        CASE ASC("&") : T += 1

          SELECT CASE AS CONST *T

          CASE ASC("h"), ASC("H") : T += 1 : b = 16 : e = 22 : EXIT DO

          CASE ASC("o"), ASC("O") : T += 1 : b = 8  : e = 8  : EXIT DO

          CASE ASC("b"), ASC("B") : T += 1 : b = 2  : e = 2  : EXIT DO

          END SELECT

        END SELECT

      END IF

      T += 1

    LOOP



    DO '                                              search valid chars

      VAR i = a

      WHILE *T <> s[i] '                                     check digit

        i += 1 : IF i > e THEN EXIT DO '              not valid -> break

      WEND



      IF i > C_DECI ANDALSO e = 14 THEN '               decimal exponent

        IF 0.0 = r THEN T += 1 : EXIT DO

        d = 0 : T += 1 : e = C_DECI

        IF *T = ASC("+") THEN T += 1 ELSE _

        IF *T = ASC("-") THEN T += 1 : y = 1

        CONTINUE DO

      END IF



      IF i THEN

        f += d : v = 0

        IF d > 0 THEN '                                     normal digit

          r *= b : r += z(i)

        ELSEIF d < 0 THEN '                             fractional digit

          r += z(i) * b ^ f

        ELSE '                                                  exponent

          x *= b : x += z(i)

        END IF

      ELSE '                                 decimal seperator just once

        a = 1 : d = -1 : f = 0

      END IF

      T += 1

    LOOP UNTIL 0 = *T '                   break at the end of the STRING

  WEND : IF x THEN RETURN IIF(n, -r, r) * 10 ^ IIF(y, -x, x)

  RETURN IIF(n, -r, r)

END FUNCTION





' ************ macros for testing *************



#MACRO TEST(_S_,_F_) '                         search all numbers in _S_

SCOPE

  ?_S_;!"\nPosition","Value"

  VAR n = _S_ & CHR(0), t = SADD(n), a = t - 1, p = t, z = get_value(t, _F_)

  WHILE t

    ?RIGHT("    " & t - a, 4);": ";

    ?RIGHT("             " & z, 13);

    ?" from substring >";LEFT(*p, t - p);"<"

    p = t

    z = get_value(t, _F_)

  WEND

END SCOPE

#ENDMACRO



#DEFINE TEST_C(_S_) TEST(_S_,1) '                 search C style numbers

#DEFINE TEST_FB(_S_) TEST(_S_,0) '               search FB style numbers



' ************ main *************



?"Read FB stuff:"

TEST_FB("In1text broken exponent.e+1, a date (two decimal values) 12.3.29 negative: -127 exponent: +15.1D-93 hexa: &hff bin:-&B11.11 octal: +++&o10+-&h&b&o4a")

?:?"Read C stuff:"

TEST_C("This is a 0. (NULL) and more values: 01234, 0xff.12, 0.41e-13 decimal: 0.77 octal: 00.77")

Ausgabe:

Read FB stuff:

In1text broken exponent.e+1, a date (two decimal values) 12.3.29 negative: -127 exponent: +15.1D-93 hexa: &hff bin:-&B11.11 octal: +++&o10+-&h&b&o4a

Position      Value

   4:             1 from substring >In1<

  28:             1 from substring >text broken exponent.e+1<

  62:          12.3 from substring >, a date (two decimal values) 12.3<

  65:          0.29 from substring >.29<

  80:          -127 from substring > negative: -127<

 100:      1.51e-92 from substring > exponent: +15.1D-93<

 111:           255 from substring > hexa: &hff<

 124:         -3.75 from substring > bin:-&B11.11<

 139:             8 from substring > octal: +++&o10<

 148:             4 from substring >+-&h&b&o4<



Read C stuff:

This is a 0. (NULL) and more values: 01234, 0xff.12, 0.41e-13 decimal: 0.77 octal: 00.77

Position      Value

  13:             0 from substring >This is a 0.<

  43:           668 from substring > (NULL) and more values: 01234<

  52:   255.0703125 from substring >, 0xff.12<

  62:       4.1e-14 from substring >, 0.41e-13<

  76:          0.77 from substring > decimal: 0.77<

  89:      0.984375 from substring > octal: 00.77<

English

See english forum thread.

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 02.04.2012 von TJF angelegt.
Die aktuellste Version wurde am 03.04.2012 von TJF gespeichert.

Bearbeiten

Versionen