Nette Proceduren zum Zahlen auswerten (erw. Val-Procedure)

Zur Vorstellung von Komponenten und Units für Lazarus
Antworten
weber_8722
Beiträge: 26
Registriert: Mo 17. Feb 2014, 10:11

Nette Proceduren zum Zahlen auswerten (erw. Val-Procedure)

Beitrag von weber_8722 »

Hi,

diese Routinen möchte ich allen zur Verfügung stellen, arbeitet ähnlich wie Val, kann aber einiges mehr:

- . oder , bei Real-Zahlen möglich
- Verarbeitung üblicher Vorsilben z.B. 1k = 1000, 1f = 1E-12, etc.
- Sonderbehandlung auch für mil und miles

Code: Alles auswählen

 
Function fValx(s : Zeile) : Double;
 
Var x :    Double;
   Code, i, j :    Integer;
 
Begin
   i:=Pos('mil',s);
   j:=Pos('miles',s);
   If (i>0) and (j=0)
      then Begin
            Valx(Copy(s,1,i-1),x,Code);
            fValx:=x*2.54*1e-2*1e-3
          End
      else If (j>0)
            then Begin
                  Valx(Copy(s,1,j-1),x,Code);
                  fValx:=x*1.6*1e3
                End
            else Begin
                  Valx(s,x,Code);
                  fValx:=x
                End
End;
 
 
 
Procedure Valx(s : Zeile; Var x : Double; Var Code : Integer);
 
 
Var
   Index :             Integer;
   Vorzeichen :          ( Negative, Positive );
   Nachkomma :          Boolean;
   DecimalCount :          Double; //LongInt; { Zählt Zehnerpotenzen, longint may have overflow problems!! }
   Exponent :             Boolean;
   Zahl :                Double;
   GueltigeZeichen :       Set of Char;
   Sonderzeichen :       Set of Char;
   st :                Zeile;
 
Begin
   Sonderzeichen:=['a','A','f','F','p','P','n','N','u','U','m','M','k','K','g','G','t','T','c','C','d','D'];
   Sonderzeichen:=   Sonderzeichen+['l','L','i','I','s','S'];
   GueltigeZeichen:=['0'..'9','.',',','+','-','E','e',' '] + Sonderzeichen;
   x:=0;
   If length(s)=0
      then Code:=1
      else If not (s[1] in GueltigeZeichen)
      then Code:=1
      else Begin
            Exponent:=False;
            Nachkomma:=False;
            Vorzeichen:=Positive;
            Zahl:=0;
            Index:=1;
            While s[Index]=' '
               Do Inc(Index);
            st:=Copy(s,Index,Length(s)-Index+1);
 
            Index:=1;
      x:=0; { neu 11.10.02 }
      Code:=1; { neu 11.10.02 }
            GueltigeZeichen:=GueltigeZeichen - [' '];
            While (Length(st)>0) and not (Index>Length(st)) and (st[Index] in GueltigeZeichen)
            { 11.10. vorher noch Probleme wenn st=''!! }
               Do Begin
                     Case st[Index] of
                      '+' :       Begin
                                 Vorzeichen:=Positive;
                                 GueltigeZeichen:=GueltigeZeichen - ['+','-'];
                              End;
                      '-' :       Begin
                                 Vorzeichen:=Negative;
                                 GueltigeZeichen:=GueltigeZeichen - ['+','-'];
                              End;
                      '0'..'9':    Begin
                                 If Nachkomma
                                    then Begin
                                          DecimalCount:=DecimalCount*10;
                                          x:=x+(ord(st[Index])-ord('0'))/DecimalCount;
                                        End
                                    else x:=10*x+ord(st[Index])-ord('0');
                                 GueltigeZeichen:=GueltigeZeichen - ['+','-',' '];
                                            Code:=0
                              End;
                      '.',',' :   Begin
                                 Nachkomma:=True;
                                 DecimalCount:=1;
                                 GueltigeZeichen:=GueltigeZeichen - ['+','-',',','.'];
                              End;
                      'E','e' :   Begin
                                 GueltigeZeichen:=GueltigeZeichen + ['+','-'];
                                 GueltigeZeichen:=GueltigeZeichen - ['E','e','.',','];
                                 GueltigeZeichen:=GueltigeZeichen - Sonderzeichen;
                                 If Vorzeichen=Negative
                                    then x:=-x;
                                 Vorzeichen:=Positive;
                                 Zahl:=x;    { speichert Mantisse }
                                 x:=0;       { speichert Exponent }
                                 DecimalCount:=0;
                                 Nachkomma:=False;
                                 Exponent:=True;
                              End;
                      'm' :       Begin
                                 x:=x*1e-3;
                                 GueltigeZeichen:=[]
                              End;
                      'D','d' :   Begin
                                 If st[Index+1] in ['b','B']
                                    then x:=x
                                    else x:=x*1e-1;
                                 GueltigeZeichen:=[]
                              End;
                      'C','c' :   Begin
                                 x:=x*1e-2;
                                 GueltigeZeichen:=[]
                              End;
                      'U','u' :   Begin
                                 x:=x*1e-6;
                                 GueltigeZeichen:=[]
                              End;
                      'N','n' :   Begin
                                 x:=x*1e-9;
                                 GueltigeZeichen:=[]
                              End;
                      'P','p' :   Begin
                                 x:=x*1e-12;
                                 GueltigeZeichen:=[]
                              End;
                      'F','f' :   Begin
                                 x:=x*1e-15;
                                 GueltigeZeichen:=[]
                              End;
                      'A','a' :   Begin
                                 x:=x*1e-18;
                                 GueltigeZeichen:=[]
                              End;
                      'K','k' :   Begin
                                 x:=x*1e3;
                                 GueltigeZeichen:=[]
                              End;
                      'M' :      Begin
                                 x:=x*1e6;
                                 GueltigeZeichen:=[]
                              End;
                      'G','g' :   Begin
                                 x:=x*1e9;
                                 GueltigeZeichen:=[]
                              End;
                       'T','t' :   Begin
                                 x:=x*1e12;
                                 GueltigeZeichen:=[]
                              End;
                     End;
               Inc(Index);
               End;
 
            If Vorzeichen=Negative
              then x:=-x;
            If Exponent
              then x:=Zahl*xy(10,x)// 10 hoch x
            {If Length(st)>0
                then Code:=0
                else Code:=1}

         End { Else }
End;


Viel Spass damit :) . Meist nehm ich fValx her, da handlicher als eine Procedure, und die Fehlerbehandlung mache ich lieber intern.
Für Integers nehme ich meist einfach Val direkt her bzw. fVali als Wrappper-Funktion.

Für weitere Ideen bin ich dankbar (man könnte z.B, auch leicht Konstanten einbauen a la Pi oder Epsilon0).

VG Stephan
Zuletzt geändert von Lori am Fr 10. Jul 2015, 21:21, insgesamt 1-mal geändert.
Grund: Highlighter

Komoluna
Beiträge: 565
Registriert: So 26. Aug 2012, 09:03
OS, Lazarus, FPC: Windows(10), Linux(Arch)
CPU-Target: 64Bit

Re: Nette Proceduren zum Zahlen auswerten (erw. Val-Procedur

Beitrag von Komoluna »

Sieht schonmal Interessant aus, aber kannst du bitte entweder die Funktion in eine Unit packen und dann hier als Anhang hochladen oder den Code in Highlighter packen?
Bsp:

Code: Alles auswählen

procedure Foo();
var
  Bar: Integer;
begin
  Bar := 1;
end;


MFG

Komoluna
Programmer: A device to convert coffee into software.

Rekursion: siehe Rekursion.

Antworten