-
Notifications
You must be signed in to change notification settings - Fork 4
/
CustomFunctionActions.vb
138 lines (119 loc) · 4.92 KB
/
CustomFunctionActions.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Imports System
Imports System.Collections.Generic
Imports System.Drawing
Imports System.Globalization
Imports System.Linq
Imports System.Text
Imports System.Threading.Tasks
#Region "#usings_CFunc"
Imports DevExpress.Spreadsheet
Imports DevExpress.Spreadsheet.Functions
Imports DevExpress.XtraSpreadsheet
#End Region ' #usings_CFunc
Namespace SpreadsheetControl_API
Public NotInheritable Class CustomFunctionActions
Private Sub New()
End Sub
#Region "Actions"
Public Shared SphereMassAction As Action(Of IWorkbook) = AddressOf SphereMassValue
#End Region
Private Shared Sub SphereMassValue(ByVal workbook As IWorkbook)
' #Region "#customfunctionuse"
' Create a custom function and add it to the global scope.
Dim customFunction As New SphereMassFunction()
If Not workbook.Functions.GlobalCustomFunctions.Contains(customFunction.Name) Then
workbook.Functions.GlobalCustomFunctions.Add(customFunction)
End If
' #End Region ' #customfunctionuse
workbook.BeginUpdate()
Try
Dim worksheet As Worksheet = workbook.Worksheets(0)
worksheet.Range("A1:H1").ColumnWidthInCharacters = 12
worksheet.Range("A1:H1").Alignment.Horizontal = SpreadsheetHorizontalAlignment.Center
worksheet.DefinedNames.Add("seawater", "1025")
worksheet.DefinedNames.Add("iron", "7870")
worksheet.DefinedNames.Add("gold", "19300")
worksheet("A1").Value = "Radius, m"
worksheet("B1").Value = "Material"
worksheet("C1").Value = "Mass, kg"
worksheet("A2").Value = 0.1
worksheet("B2").Value = ""
worksheet("C2").FormulaInvariant = "=SPHEREMASS(A2)"
worksheet("C2").NumberFormat = "#.##"
worksheet("A3").Value = 0.1
worksheet("B3").Value = "Seawater"
worksheet("C3").FormulaInvariant = "=SPHEREMASS(A3, seawater)"
worksheet("C3").NumberFormat = "#.##"
worksheet("A4").Value = 0.1
worksheet("B4").Value = "Iron"
worksheet("C4").FormulaInvariant = "=SPHEREMASS(A4, iron)"
worksheet("C4").NumberFormat = "#.##"
worksheet("A5").Value = 0.1
worksheet("B5").Value = "Gold"
worksheet("C5").FormulaInvariant = "=SPHEREMASS(A5, gold)"
worksheet("C5").NumberFormat = "#.##"
Finally
workbook.EndUpdate()
End Try
End Sub
End Class
#Region "#customfunctiondef"
' Inheritance from Object is required for automatic VB.NET conversion
Public Class SphereMassFunction
Implements ICustomFunction
Private Const functionName As String = "SPHEREMASS"
Private ReadOnly functionParameters() As ParameterInfo
Public Sub New()
' Missing optional parameters do not result in an error message.
Me.functionParameters = New ParameterInfo() {
New ParameterInfo(ParameterType.Value, ParameterAttributes.Required),
New ParameterInfo(ParameterType.Value, ParameterAttributes.Optional)
}
End Sub
Public ReadOnly Property Name() As String Implements IFunction.Name
Get
Return functionName
End Get
End Property
Private ReadOnly Property IFunction_Parameters() As ParameterInfo() Implements IFunction.Parameters
Get
Return functionParameters
End Get
End Property
Private ReadOnly Property IFunction_ReturnType() As ParameterType Implements IFunction.ReturnType
Get
Return ParameterType.Value
End Get
End Property
Private ReadOnly Property IFunction_Volatile() As Boolean Implements IFunction.Volatile
Get
Return False
End Get
End Property
Private Function IFunction_Evaluate(ByVal parameters As IList(Of ParameterValue), ByVal context As EvaluationContext) As ParameterValue Implements IFunction.Evaluate
Dim radius As Double
Dim density As Double = 1000
Dim radiusParameter As ParameterValue
Dim densityParameter As ParameterValue
If parameters.Count = 2 Then
densityParameter = parameters(1)
If densityParameter.IsError Then
Return densityParameter
Else
density = densityParameter.NumericValue
End If
End If
radiusParameter = parameters(0)
If radiusParameter.IsError Then
Return radiusParameter
Else
radius = radiusParameter.NumericValue
End If
Return (4 * Math.PI) / 3 * Math.Pow(radius,3) * density
End Function
Private Function IFunction_GetName(ByVal culture As CultureInfo) As String Implements IFunction.GetName
Return functionName
End Function
End Class
#End Region ' #customfunctiondef
End Namespace