| File: Microsoft\VisualBasic\CompilerServices\DoubleType.vb | Web Access |
| Project: src\runtime\src\libraries\Microsoft.VisualBasic.Core\src\Microsoft.VisualBasic.Core.vbproj (Microsoft.VisualBasic.Core) |
' Licensed to the .NET Foundation under one or more agreements. ' The .NET Foundation licenses this file to you under the MIT license. Imports System Imports System.Globalization Imports Microsoft.VisualBasic.CompilerServices.DecimalType Imports Microsoft.VisualBasic.CompilerServices.Utils Namespace Microsoft.VisualBasic.CompilerServices <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never)> Public NotInheritable Class DoubleType ' Prevent creation. Private Sub New() End Sub Public Shared Function FromString(ByVal Value As String) As Double Return FromString(Value, Nothing) End Function Public Shared Function FromString(ByVal Value As String, ByVal NumberFormat As NumberFormatInfo) As Double If Value Is Nothing Then Return 0 End If Try Dim i64Value As Int64 If IsHexOrOctValue(Value, i64Value) Then Return CDbl(i64Value) End If Return DoubleType.Parse(Value, NumberFormat) Catch e As FormatException Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromStringTo, Left(Value, 32), "Double"), e) End Try End Function Public Shared Function FromObject(ByVal Value As Object) As Double Return FromObject(Value, Nothing) End Function Public Shared Function FromObject(ByVal Value As Object, ByVal NumberFormat As NumberFormatInfo) As Double If Value Is Nothing Then Return 0 End If Dim valueInterface As IConvertible Dim valueTypeCode As TypeCode valueInterface = TryCast(Value, IConvertible) If valueInterface Is Nothing Then GoTo ThrowInvalidCast End If valueTypeCode = valueInterface.GetTypeCode() Select Case valueTypeCode Case TypeCode.Boolean Return CDbl(valueInterface.ToBoolean(Nothing)) Case TypeCode.Byte If TypeOf Value Is System.Byte Then Return CDbl(DirectCast(Value, Byte)) Else Return CDbl(valueInterface.ToByte(Nothing)) End If Case TypeCode.Int16 If TypeOf Value Is System.Int16 Then Return CDbl(DirectCast(Value, Int16)) Else Return CDbl(valueInterface.ToInt16(Nothing)) End If Case TypeCode.Int32 If TypeOf Value Is System.Int32 Then Return CDbl(DirectCast(Value, Int32)) Else Return CDbl(valueInterface.ToInt32(Nothing)) End If Case TypeCode.Int64 If TypeOf Value Is System.Int64 Then Return CDbl(DirectCast(Value, Int64)) Else Return CDbl(valueInterface.ToInt64(Nothing)) End If Case TypeCode.Single If TypeOf Value Is System.Single Then Return DirectCast(Value, Single) Else Return CDbl(valueInterface.ToSingle(Nothing)) End If Case TypeCode.Double If TypeOf Value Is System.Double Then Return CDbl(DirectCast(Value, Double)) Else Return CDbl(valueInterface.ToDouble(Nothing)) End If Case TypeCode.Decimal 'Do not use .ToDecimal because of jit temp issue effects all perf Return DecimalToDouble(valueInterface) Case TypeCode.String Return DoubleType.FromString(valueInterface.ToString(Nothing), NumberFormat) Case TypeCode.Char, TypeCode.DateTime ' Fall through to error Case Else ' Fall through to error End Select ThrowInvalidCast: Throw New InvalidCastException(SR.Format(SR.InvalidCast_FromTo, VBFriendlyName(Value), "Double")) End Function Private Shared Function DecimalToDouble(ByVal ValueInterface As IConvertible) As Double Return CDbl(ValueInterface.ToDecimal(Nothing)) End Function Public Shared Function Parse(ByVal Value As String) As Double Return Parse(Value, Nothing) End Function Friend Shared Function TryParse(ByVal Value As String, ByRef Result As Double) As Boolean Dim numberFormat As NumberFormatInfo Dim normalizedNumberFormat As NumberFormatInfo Dim culture As CultureInfo = GetCultureInfo() numberFormat = culture.NumberFormat normalizedNumberFormat = GetNormalizedNumberFormat(numberFormat) Const flags As NumberStyles = NumberStyles.AllowDecimalPoint Or NumberStyles.AllowExponent Or NumberStyles.AllowLeadingSign Or NumberStyles.AllowLeadingWhite Or NumberStyles.AllowThousands Or NumberStyles.AllowTrailingSign Or NumberStyles.AllowParentheses Or NumberStyles.AllowTrailingWhite Or NumberStyles.AllowCurrencySymbol Value = ToHalfwidthNumbers(Value, culture) ' The below code handles the 80% case efficiently and is inefficient only when the numeric and currency settings ' are different If numberFormat Is normalizedNumberFormat Then Return System.Double.TryParse(Value, flags, normalizedNumberFormat, Result) Else Try ' Use numeric settings to parse ' Note that we use Parse instead of TryParse in order to distinguish whether the conversion failed ' due to FormatException or other exception like OverFlowException, etc. Result = System.Double.Parse(Value, flags, normalizedNumberFormat) Return True Catch FormatEx As FormatException ' Use currency settings to parse Try Return System.Double.TryParse(Value, flags, numberFormat, Result) Catch ex As ArgumentException Return False End Try Catch ex As StackOverflowException Throw ex Catch ex As OutOfMemoryException Throw ex Catch Ex As Exception Return False End Try End If End Function Public Shared Function Parse(ByVal Value As String, ByVal NumberFormat As NumberFormatInfo) As Double Dim normalizedNumberFormat As NumberFormatInfo Dim culture As CultureInfo = GetCultureInfo() If NumberFormat Is Nothing Then NumberFormat = culture.NumberFormat End If ' Normalize number format settings to enable us to first use the numeric settings for both currency and number parsing ' compatible with VB6 normalizedNumberFormat = GetNormalizedNumberFormat(NumberFormat) Const flags As NumberStyles = NumberStyles.AllowDecimalPoint Or NumberStyles.AllowExponent Or NumberStyles.AllowLeadingSign Or NumberStyles.AllowLeadingWhite Or NumberStyles.AllowThousands Or NumberStyles.AllowTrailingSign Or NumberStyles.AllowParentheses Or NumberStyles.AllowTrailingWhite Or NumberStyles.AllowCurrencySymbol Value = ToHalfwidthNumbers(Value, culture) Try ' Use numeric settings to parse Return System.Double.Parse(Value, flags, normalizedNumberFormat) Catch FormatEx As FormatException When Not (NumberFormat Is normalizedNumberFormat) ' Use currency settings to parse Return System.Double.Parse(Value, flags, NumberFormat) Catch Ex As Exception Throw Ex End Try End Function End Class End Namespace