Const False=0, True=Not False
#define UNICODE
#include once "windows.bi"
#include "disphelper/disphelper.bi"
#include "vbcompat.bi"

Function Runde(Variable As Double, Nachkomma As Integer) As Double
	Dim Wert As Double=10^Nachkomma 'Lieber Double, man weiß ja nie..
  Return CInt(Variable*Wert)/Wert
End Function

Function Round(Variable As Double, Nachkomma As Integer) As Double
	Dim As String s=Format(Variable, "##." &String(Nachkomma,"0"))
	Dim As Integer i=InStr(s, ",") 'Sollte wirklich ein Komma im String sein?
	If i Then s[i-1]+=2 '..dann aber ändern xD
  Return Val(s)
End Function

Sub RunScript(byVal ReturnID As LPWSTR, _
              byVal ErgebnisPtr As LPVOID, _
              byVal ScriptText As LPWSTR, _
              byVal ScriptSprache As LPWSTR _
             )
  Dispatch_Obj(ScriptControl)
	If Succeeded(dhCreateObject("MSScriptControl.ScriptControl", Null, @ScriptControl)) Then
		If Succeeded(dhPutValue(ScriptControl, ".Language = %T", ScriptSprache)) Then
			dhPutValue(ScriptControl, ".AllowUI = %b", True)
			dhPutValue(ScriptControl, ".UseSafeSubset = %b", False)
      If ErgebnisPtr Then
				dhGetValue(ReturnID, ErgebnisPtr, ScriptControl, ".Eval(%T)", ScriptText)
			Else
				dhCallMethod(ScriptControl, ".Eval(%T)", ScriptText)
			End If
		End If
	End If
	Safe_Release(ScriptControl)
End Sub

Function RoundVbs(Zahl As Double, Nachkomma As Integer) As Double
  Dim i As Integer, s As String
  Dim tResult As ZString Ptr
  dhInitialize(True)
  dhToggleExceptions(True)
  RunScript("%s", @tResult, "Round(" &Zahl &", " &Nachkomma &")", "VBScript")
  dhUninitialize(True)
  s=*tResult  
  i=InStr(s, ",") 'Sollte wirklich ein Komma im String sein?
	If i Then s[i-1]+=2 '..dann aber ändern xD
  Return Val(s)
End Function

Dim As Double Pi=4.0*Atn(1.0), Test

Print "FreeBASIC"
Print Pi
Print !"\nRunde"
Test=Runde(Pi, 4)
Print "Pi=" &Test
Print "Pi=";:Print Using"#.######";Test

Print !"\nRound"
Test=Round(Pi, 4)
Print "Pi=" &Test
Print "Pi=";:Print Using"#.######";Test

Print !"\nRoundVBS"
Test=RoundVbs(Pi, 4)
Print "Pi=" &Test
Print "Pi=";:Print Using"#.######";Test
GetKey
End