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

[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

[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