I have a method in my class which returns a list of data's
Private Function GetCertificationLevels()
Dim theProgramYearID As Int32 = Convert.ToInt32(lstProgramYear.SelectedValue)
Dim thePositionGroupID As Int32 = Convert.ToInt32(lstPositionGroup.Selected)
Dim theCategoryID As Int32 = Convert.ToInt32(lstCategory.SelectedValue)
filterLevels = _curTree.GetCertificationLevelsList(theProgramYearID, thePositionGroupID, theCategoryID)
Return filterLevels
End Function
I would like to retrieve the _data value only (which are 5261,5263,5262,5264 and 5260)
How to proceed?
If I understand your question right, then you are trying to use the values of the variables theProgramYearID, thePositionGroupID, and theCategoryID in another procedure. I would create an overloaded procedure that contains ByRef arguments, and then use them in the other procedure.
Private Sub CallingProcedure()
'Declare variables to hold the ByRef results.
Dim locYearID, locGroupID, locCategoryID as Integer
'Call the procedure, and pass the variables for processing
Dim FunctionResult = GetCertificationLevels(locYearID, locGroupID, locCategoryID)
'Now do whatever you need with the modified variables
SomeOtherProcedure()
End Sub
Private Overloads Function GetCertificationLevels(ByRef theProgramYearID as Int32, ByRef thePositionGroupID as Int32, ByRef theCategoryID as Int32)
theProgramYearID = Convert.ToInt32(lstProgramYear.SelectedValue)
thePositionGroupID = Convert.ToInt32(lstPositionGroup.Selected)
theCategoryID = Convert.ToInt32(lstCategory.SelectedValue)
filterLevels = _curTree.GetCertificationLevelsList(theProgramYearID, thePositionGroupID, theCategoryID)
Return filterLevels
End Function
The ByRef will ensure that the function is modifying the variables passed to it, and they will have the values assigned to them in the function.
Using LINQ:
Return filterLevels.Select(Function(t) t.Data).ToList()
Related
I have a module that defines a UDT as follows:
Private Type UserData
uName As String 'user name
uDate As Date 'date/time of last interaction
End Type
I have a simple test function that I'm trying to use to compare two different instances of the UDT as follows:
Sub TestCheck()
Dim testRec(1) As UserData
testRec(0).uName = "a"
testRec(0).uDate = Date
testRec(1) = testRec(0)
If testRec(1) = testRec(0) Then
Debug.Print "Records match"
Else
Debug.Print "Records don't match"
End If
End Sub
I get Compile error: Type mismatch on testRec(1) = testRec(0)
I really would rather not have to loop through each member of each instance in order to check for equivalency. Aren't UDTs supposed to act as variables? If I have to loop through each member of each instance to compare them, then it really doesn't save anything for me to use the UDTs. Is there a way to do the comparison without looping through the members?
For anyone who has the same question, based on Brian M Stafford's comments, the simple answer is no.
However, here's a simple function to get the job done:
Private Function UserDataEqual(ByRef varA As UserData, ByRef varB As UserData) As Boolean
If varA.uName = varB.uName _
And varA.uDate = varB.uDate Then
UserDataEqual = True
Else
UserDataEqual = False
End If
End Function
It would be used as follows:
Sub TestCheck()
Dim testRec(1) As UserData
testRec(0).uName = "a"
testRec(0).uDate = Date
testRec(1) = testRec(0)
If UserDataEqual(testRec(1), testRec(0)) Then
Debug.Print "Records match"
Else
Debug.Print "Records don't match"
End If
End Sub
Thanks for answering my questions Brian.
This type of activity is what Classes are for. Instead of a user defined type create a class with appropriate methods. Here we have defined a Class called UserData which has a predeclared Id so that we can use the class as a UserData Factory. In this example we have
UserData Class
' User Rubberduck annotations to set the predecalredId to True
'#PredeclaredId
Option Explicit
Public Enum UserDataType
udDate
udName
End Enum
Private Type Properties
UserData As Object
End Type
Private p As Properties
Public Function Make(ByVal ipName As String, ByVal ipDateAndTime As Date) As UserData
With New UserData
Set Make = .Self(ipName, ipDateAndTime)
End With
End Function
Public Function Self(ByVal ipName As String, ByVal ipDateAndTime As Date) As UserData
' Use late bound crreation of a scripting dictionary to avoid reference issues
Set p.UserData = CreateObject("Scripting.Dictionary")
With p.UserData
.Add udName, ipName
.Add udDate, ipDateAndTime
End With
Set Self = Me
End Function
Public Property Get Item(ByVal ipEnum As Long) As Variant
Item = p.UserData.Item(ipEnum)
End Property
Public Property Let Item(ByVal ipEnum As Long, ByVal ipValue As Variant)
p.UserData.Item(ipEnum) = ipValue
End Property
Public Function SameAs(ByVal ipUserData As UserData) As Boolean
SameAs = False
Dim myIndex As Long
For myIndex = 0 To p.UserData.Count - 1
If Me.Item(myIndex) <> ipUserData.Item(myIndex) Then Exit Function
Next
SameAs = True
End Function
This class makes the creation of user data types a bit easier as we can now just say UserData,Make( ,
So the text sub can become
Option Explicit
Public Sub TestCheck()
Dim testRec(1) As UserData
Set testRec(0) = UserData.Make("a", Date)
Set testRec(1) = UserData.Make("b", Date)
If testRec(1).SameAs(testRec(0)) Then
Debug.Print "Records match"
Else
Debug.Print "Records don't match"
End If
End Sub
As you can see. You can see. To change the UserData class for a different set of members you only have to change the enumeration (provided you keep to simple variables).
Simple answer probably what you were looking for (although won't work in your situation I'm afraid, I'll explain):
'#Description("Returns the count of bytes which match over length")
Public Declare PtrSafe Function RtlCompareMemory Lib "ntdll" ( _
ByRef a As Any, _
ByRef b As Any, _
ByVal Length As LongPtr _
) As LongPtr
Called like:
Debug.Assert RtlCompareMemory(a, b, LenB(a)) = LenB(a) 'checks every byte matches
'Or as a function ?UserDataMatch(a,b)
Public Function UserDataMatch(ByRef a As UserData, ByRef b As UserData) As Boolean
UserDataMatch = RtlCompareMemory(a, b, LenB(a)) = LenB(a)
End Function
The catch is this won't work for you because Strings are stored in the UDT as pointers to some variable length block of memory containing their actual values (and these pointers will never match in VBA). So my approach only works for fixed sized UDTs, e.g.:
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Public Type UDT
IID As GUID 'nested is fine
ClsID As GUID
RefCount As Long
MyClass As Object 'even classes and objects work - if the UDTs point to the same instance
End Type
But not for a UDT which contains a string or some other immutable reference type where the pointers can never be shared between two variables without low level hackery.
I'm trying to calculate the total count and value of orders for a customer, using the code below.
Dim iOrderCount As Integer
Dim iLineCount As Integer
Dim cTotalGoods As Decimal
Dim cTotalVat As Decimal
Dim cTotalDelivery As Decimal
Using manOrders As New CManOrders(m_dbSql)
manOrders.GetOrdersInProgress(sAccountCode, iOrderCount, iLineCount, cTotalGoods, cTotalVat, cTotalDelivery)
When I assign values to these variables in the GetOrdersInProgress subroutine, the values are being assigned correctly, which I can see when I step through the code.
Public Sub GetOrdersInProgress(sAccountCode As String, ByRef RET_orderCount As Integer, ByRef RET_lineCount As Integer,
ByRef RET_totalGoods As Decimal, ByRef RET_totalVat As Decimal, RET_totalDelivery As Decimal)
...
For Each dr As DataRow In m_dbSql.getDataTable(sql).Rows
RET_orderCount = dbToInt(dr(ORDER_COUNT))
RET_lineCount = dbToInt(dr(LINE_COUNT))
RET_totalGoods = dbToDecimal(dr(TOTAL_GOODS))
RET_totalVat = dbToDecimal(dr(TOTAL_VAT))
RET_totalDelivery = dbToDecimal(dr(2))
Return
Next
However, once I step through and move back into where the GetOrdersInProgress subroutine is called from, all of the values in the variables are returned correctly, except for RET_totalDelivery - the new one I've added to another developer's project.
The value in the RET_totalDelivery variable in the Public Sub GetOrdersInProgress... line is correct and it's correct after the assignment, but when it reaches Return and the variables are then used in the parent subroutine, for some reason they're all correct except for the new one I've added, RET_totalDelivery. I'd understand if the value wasn't being assigned correctly, however it is.
Why would it be returning 0 all the time?
By default, arguments passed to vb.net methods are passed by value, or ByVal. You did not specify ByRef in your RET_totalDelivery argument in GetOrdersInProgress.
Changes made to arguments passed by value are not retained when the method ends.
Your Sub should now be...
Public Sub GetOrdersInProgress(sAccountCode As String, ByRef RET_orderCount As Integer, ByRef RET_lineCount As Integer, ByRef RET_totalGoods As Decimal, ByRef RET_totalVat As Decimal, ByRef RET_totalDelivery As Decimal)
I prefer to write the method as a function. Write a class to hold all the return values. Then change the method into a function with just input parameters and return the values you fetch from sql.
Sub Main
Dim bl = New OrdersInProgressBusinessLogic()
Dim ordersInProgress = bl.GetOrdersInProgress("some account code")
End Sub
Public Class OrdersInProgress
Public Property OrderCount As Integer
Public Property LineCount As Integer
Public Property TotalGoods As Decimal
Public Property TotalVat As Decimal
Public Property TotalDelivery As Decimal
End Class
Public Class OrdersInProgressBusinessLogic
Public Function GetOrdersInProgress(sAccountCode As String) As OrdersInProgress
Dim ordersInProgress = New OrdersInProgress()
' some code here to fetch data from sql
For Each dr As DataRow In m_dbSql.getDataTable(sql).Rows
With ordersInProgress
.OrderCount = dbToInt(dr(ORDER_COUNT))
.LineCount = dbToInt(dr(LINE_COUNT))
.TotalGoods = dbToDecimal(dr(TOTAL_GOODS))
.TotalVat = dbToDecimal(dr(TOTAL_VAT))
.TotalDelivery = dbToDecimal(dr(2))
End With
Next
Return ordersInProgress
End Function
' some other functions/subs for OrdersInProgress class
End Class
Does VB support assignment to a tuple? If so what is the Syntax?
Private Function GetPeStream(metadataDiagnostics As DiagnosticBag, peStreamProvider As EmitStreamProvider, metadataOnly As Boolean) As (peStream As Stream, signingStream As Stream, selectedStream As Stream)
Return ...
End Function
Dim ret As Stream
Dim peStream as Stream
Dim signingInputStream as Stream
(peStream, signingInputStream, ret) = GetPeStream(metadataDiagnostics, peStreamProvider, metadataOnly)
You can use below syntax for tuples to initialize and assign in single line.
Dim x As Tuple(Of Stream, Stream, Stream)= New Tuple(of Stream,Stream,Stream)(str1,str2,str3)
Important: Make sure you have str1,str2 and str3 instantiated and assigned to values before direct assignment above
You can avoid using Item1, Item2, etc, using the example bellow.
Private Function GetPeStream(metadataDiagnostics As DiagnosticBag, peStreamProvider As EmitStreamProvider, metadataOnly As Boolean) As (peStream As Stream, signingStream As Stream, selectedStream As Stream)
.....
Return (processed_peStream, processed_signingStream,processed_selectedStream)
End Function
Private Function ConsumingGetPeStream()...
'Calling the function
Dim Your_Result_From_GetPeStream = GetPeStream(metadataDiagnostics_value, peStreamProvider_value, metadataOnly_Value)
'Using returned values from function
Your_Result_From_GetPeStream.peStream
Your_Result_From_GetPeStream.signingStream
Your_Result_From_GetPeStream.selectedStream
End Function
A more simple version for better undesrtanding
Public Sub Main()
Dim ReturnFunctionWithTuple = FunctionWithTuple()
Console.WriteLine($"Your long: {ReturnFunctionWithTuple.YourFieldLong}")
Console.WriteLine($"Your date: {ReturnFunctionWithTuple.YourFieldDate}")
Console.WriteLine($"Your bool: {ReturnFunctionWithTuple.YourFiedBoolean}")
End Sub
Public Function FunctionWithTuple() As (YourFieldLong As Long, YourFieldDate As Date, YourFiedBoolean As Boolean)
Return (55, #01/01/2021#, False)
End Function
Declare the tuple variable and the function return type with the generic syntax, so that the types line up. For example:
Public Sub GetTuple()
Dim x As Tuple(Of String, String, Integer)
x = GetData()
End Sub
Public Function GetData() As Tuple(Of String, String, Integer)
Dim y = New Tuple(Of String, String, Integer)("A", "B", 27)
Return y
End Function
In order to do it you have to create a new Tuple that accepts the assignment as shown by PKing and then manually copy each variable one at a time.
Dim x As Tuple(Of Stream, Stream, Stream)
x = GetData()
Dim eStream as Stream = x.Item1
Dim signingInputStream as Stream = x.Item2
Dim Ret as Stream = x.Item3
Of course the assignments would be in a loop and have code dealing with the types.
I am currently using CallByName to dynamically call methods. There are several methods which I pick up daily from a table in server along with the arguments. For this reason, I send an array of the arguments to CallByName rather than a param array as I don't know the number of arguments until runtime. Given CallByName expects a paramarray I use a private declare function to bypass the VBA Type definition.
Private Declare PtrSafe Function rtcCallByName Lib "VBE7.DLL" ( _
ByVal Object As Object, _
ByVal ProcName As LongPtr, _
ByVal CallType As VbCallType, _
ByRef Args() As Any, _
Optional ByVal lcid As Long) As Variant
Public Function CallByNameMethod(Object As Object, ProcName As String, ByRef Args () As Variant)
AssignResult CallByNameMethod, rtcCallByName(Object, StrPtr(ProcName), VbMethod, Args)
End Function
Private Sub AssignResult(target, Result)
If VBA.IsObject(Result) Then Set target = Result Else target = Result
End Sub
This works when I pass an object where the method changes its underlying properties. However, there are some methods where I pass an object and a method which changes the values of the passed arguments. For example, I pass an array with the following arguments
Dim Name as String, Value1 as double, Value2 as double, Value3 as double
Dim Array(3) as Variant
String = "Name"
Value1 = 0
Value2 = 0
Value3 = 0
Array(0) = Name
Array(1) = Value1
Array(2) = Value2
Array(3) = Value3
When I Pass that array, the method just returns the array back with the same values, but I am expecting double type values for Array(1), Array(2), Array(3). Any ideas?
The the first clue to the answer lies in the function declaration for rtcCallByName (pulled from the exports table of vbe7.dll):
function CallByName(Object: IDispatch; ProcName: BSTR; CallType: VbCallType; Args: ^SafeArray; out lcid: I4): Variant; stdcall;
Note that Args is declared as a pointer to a SafeArray, but is not declared as an out parameter. This means that the COM contract for the function is basically saying that if you pass a ParamArray the only guarantee that it makes is that it won't change pointer to the ParamArray itself. The ByRef in the Declare Function only indicates that you are passing a pointer.
As for the values inside the ParamArray, there really isn't much Microsoft documentation I can dig up specific to VBA, but the VB.NET version of the documentation gives the second clue:
A ParamArray parameter is always declared using ByVal (Visual Basic).
In the context of CallByName, this make perfect sense. The rtcCallByName function itself doesn't (and can't) know which of the parameters for the called method are themselves declared ByRef or ByVal, so it has to assume that it can't change them.
As far as implementations to work around this limitation, I'd suggest either refactoring to eliminate return values that are passed ByRef in code called by CallByName or wrapping the needed functionality in a class.
Turns out this is actually possible, see the RunMacro method in this post:
https://codereview.stackexchange.com/q/273741/146810
Which copies the paramarray into a variant array to pass to rtcCallByName whilst preserving the ByRef flag of the variants, using this CloneParamArray method:
https://github.com/cristianbuse/VBA-MemoryTools/blob/f01b0818930fb1708caaf5fc99812abdeaa9f1df/src/LibMemory.bas#L890
I have this function in my generator.
Private Sub AddBoundedValue(ByVal boundedValue As Object, ByVal type As CodeTypeDeclaration, ByVal numericType As Type, name As String)
If boundedValue IsNot Nothing Then
Dim constant As New CodeMemberField(numericType, name)
constant.Attributes = MemberAttributes.Const Or MemberAttributes.Public
constant.InitExpression = New CodePrimitiveExpression(Convert.ChangeType(boundedValue, numericType))
type.Members.Add(constant)
End If
End Sub
If a developer passes a decimal in for the "boundedValue" parameter and the decimal type for the "numericType" parameter the following code gets generated.
Public Const DollarAmountMaximumValue As Decimal = 100000
Despite the data type being passed into the constructor of the CodePrimitiveExpression object being a decimal, the code generated is an integer that gets implicitly converted and stored in a decimal variable. Is there any way to get it to generate with the "D" after the number as in:
Public Const DollarAmountMaximumValue As Decimal = 100000D
Thanks.
Well, I'm not happy about this solution but unless someone has a better one I'll have to go with it.
Private Sub AddBoundedValue(ByVal boundedValue As Object, ByVal type As CodeTypeDeclaration, ByVal numericType As Type, name As String)
If boundedValue IsNot Nothing Then
Dim constant As New CodeMemberField(numericType, name)
constant.Attributes = MemberAttributes.Const Or MemberAttributes.Public
If numericType Is GetType(Decimal) AndAlso [I detect if the language is VB.NET here] Then
constant.InitExpression = New CodeSnippetExpression(boundedValue.ToString & "D")
Else
constant.InitExpression = New CodePrimitiveExpression(Convert.ChangeType(boundedValue, numericType))
End If
type.Members.Add(constant)
End If
End Sub