Menü

Mail Listen Archiv | Code Startseite | Anzeige aller Code Fragmente

4D Code Library

4D Support Center - 4D Code Beispiel zum Thema:

NumCompute

Erfaßt von: Bernd Fröhlich (eMail: befr@eaglesoft.de ) am 22.09.2006 ; -
Letzte Änderung: 11.10.2006

Kurzbeschriebung:

NumCompute berechnet aus einem übergebenen String das numerische Ergebnis.

Beschreibung

Beschreibung ändern (nur für Autor - Kennwort geschützt) Keine Beschreibung für NumCompute

4D Code Beispiel

` Methode: NumCompute
  ` Angelegt: BF 20.09.06
  ` Version 0.2 vom 11.10.06
  ` Objekt: Allgemeine Dienstroutine
  ` Beschreibung: Berechnet das Ergebnis der als Text übergebenen Formel
  ` ----------------------------------------------------

C_TEXT($1;$tFormula)  `Formel
$tFormula:=$1
C_REAL($0)  `Ergebnis

ARRAY TEXT($atFormula;100)
ARRAY TEXT($atWhat;100)
C_TEXT($tWhat)
C_STRING(2;$Char)
C_LONGINT($i;$lIndex;$lPosOpen;$lPosClose)
C_REAL($rIntermediate)

$lPosClose:=Position(")";$tFormula)
While ($lPosClose>0)  `Dann erstmal den geklammerten Teilstring berechnen
	$lPosOpen:=0
	$i:=$lPosClose-1
	While ($i>0)
		If ($tFormula[[$i]]="(")
			$lPosOpen:=$i
			$i:=0
		Else 
			$i:=$i-1
		End if 
	End while 
	$rIntermediate:=NumCompute (Substring($tFormula;$lPosOpen+1;$lPosClose-$lPosOpen-1))
	If ($lPosOpen>1)
		$tFormula:=Substring($tFormula;1;$lPosOpen-1)+String($rIntermediate)+Substring($tFormula;$lPosClose+1)
	Else 
		$tFormula:=String($rIntermediate)+Substring($tFormula;$lPosClose+1)
	End if 
	$lPosClose:=Position(")";$tFormula)
End while 
If (Position("(";$tFormula)>0)
	ALERT("Klammerfehler!")
End if

$tWhat:=""
$lIndex:=0
For ($i;1;Length($tFormula))
	$Char:=$tFormula[[$i]]
	Case of 
		: (($Char="-") & ($tWhat#"Zahl"))  `Dann ist das Minus ein Vorzeichen und kein Operator
			$tWhat:="Zahl"
			$lIndex:=$lIndex+1
			$atFormula{$lIndex}:=$atFormula{$lIndex}+$Char
			
		: ((($Char>="0") & ($Char<="9")) | ($Char=","))  `Zeichen ist Teil einer Zahl
			If ($tWhat#"Zahl")
				$tWhat:="Zahl"
				$lIndex:=$lIndex+1
			End if 
			$atFormula{$lIndex}:=$atFormula{$lIndex}+$Char
			
		: (($Char="*") | ($Char="/"))
			If ($tWhat#"Zahl")
				ALERT("Fehler: Mehrere Operatoren hintereinander!")
			Else 
				$tWhat:="Punktrechnung"
				$lIndex:=$lIndex+1
				$atFormula{$lIndex}:=$atFormula{$lIndex}+$Char
			End if 
			
		: (($Char="+") | ($Char="-"))
			If ($tWhat#"Zahl")
				ALERT("Fehler: Mehrere Operatoren hintereinander!")
			Else 
				$tWhat:="Strichrechnung"
				$lIndex:=$lIndex+1
				$atFormula{$lIndex}:=$atFormula{$lIndex}+$Char
			End if 
			
		Else 
			  `Ungültige Zeichen einfach ignorieren
	End case 
	$atWhat{$lIndex}:=$tWhat
End for 
ARRAY TEXT($atFormula;$lIndex)
ARRAY TEXT($atWhat;$lIndex)
  `Nun steht die Formal nach Zahlen und Operanden getrennt im Array

`Erstmal Punktrechnung ausführen
$i:=2
While ($i<(Size of array($atFormula)))
	If (($atWhat{$i}="Punktrechnung") & ($atWhat{$i-1}="Zahl") & ($atWhat{$i+1}="Zahl"))
		Case of 
			: ($atFormula{$i}="*")
				$atFormula{$i-1}:=String(Num($atFormula{$i-1})*Num($atFormula{$i+1}))
				
			: ($atFormula{$i}="/")
				If (Num($atFormula{$i+1})#0)
					$atFormula{$i-1}:=String(Num($atFormula{$i-1})/Num($atFormula{$i+1}))
				Else 
					ALERT("Fehler: Division durch 0!")
					$atFormula{$i-1}:="0"
				End if 
			Else 
				ALERT("Case-Fehler!")
		End case 
		DELETE ELEMENT($atFormula;$i;2)
		DELETE ELEMENT($atWhat;$i;2)
	Else 
		$i:=$i+1
	End if 
End while

`Jetzt Strichrechnung ausführen
$i:=2
While ($i<(Size of array($atFormula)))
	If (($atWhat{$i}="Strichrechnung") & ($atWhat{$i-1}="Zahl") & ($atWhat{$i+1}="Zahl"))
		Case of 
			: ($atFormula{$i}="+")
				$atFormula{$i-1}:=String(Num($atFormula{$i-1})+Num($atFormula{$i+1}))
				
			: ($atFormula{$i}="-")
				$atFormula{$i-1}:=String(Num($atFormula{$i-1})-Num($atFormula{$i+1}))
				
			Else 
				ALERT("Case-Fehler!")
		End case 
		DELETE ELEMENT($atFormula;$i;2)
		DELETE ELEMENT($atWhat;$i;2)
	Else 
		$i:=$i+1
	End if 
End while

If (Size of array($atFormula)=1)  `Alles bestens, wir haben das Ergebnis
	$0:=Num($atFormula{1})
Else 
	ALERT("Fehler in "+Current method name+"!")
End if

Code ändern (nur für Autor - Kennwort geschützt)

Zurück

When the solution matters

International Sites

4D Produkte

Referenzen

Corporate

Support

Vertrieb

Menü

4D Code Library