I am trying to ReDim a member array based on reading a file. I cannot figure out how to do it. This is what I tried, but it does not work.
Public Class BS
Public A() As String
Public B() As Double
Public C() As Double
End Class
Public Class SB
Public MyBS() As BS
'ReadFieldString is a function that returns a string of the field name of Class BS,
'i.e., A, B or C. For test purpose, retun a constant
Public Function ReadFieldString() As String
Return "B"
End Function
'GetArrayDim is a function that returns an integer, which is the size of the array
'of that field name. For test purpose, retun a constant
Public Function GetArrayDim() As Integer
Return 1
End Function
Public Sub DimArrays()
ReDim MyBS(3)
Dim i As Integer
For i = 0 To MyBS.Length - 1
'Try to ReDim the member of MyBS
ReDim MyBS(i).GetType.GetField(ReadFieldString)(GetArrayDim)
Next()
End Sub
End Class
The ReDim statement has the error "Expression is a value and therefore cannot be the target of an assignment."
Thanks in advance.
I'm not sure ReDim works like that. Changing the code to this will achieve what I believe you are after:
Public Sub DimArrays()
ReDim MyBS(3)
Dim i As Integer
For i = 0 To MyBS.Length - 1
MyBS(i) = New BS()
Dim f = GetType(BS).GetField(ReadFieldString())
f.SetValue(MyBS(i), Array.CreateInstance(f.FieldType.GetElementType(), GetArrayDim()))
Next
End Sub
However, I think a better approach would be to specify the array size in the BS constructor.
Related
How can I at run-time determine the length of a generic type (with constraint Structure).
I need the byte count to create a view accessor of a MemoryMappedFile (which is initialized in the constructor).
Private goVirtualFile As MemoryMappedFile
Private glLength As Long = 0
Public Class CTest(Of T As Structure)
Public Sub Append(tData As T())
Dim iNumStruct As Integer = tData.Length 'Number of structures.
Dim iStructLen As Integer = ... 'Length of 1 structure in bytes.
Dim iBytes As Integer = iNumStruct * iStructLen 'Total length in bytes.
Using goViewStream = goVirtualFile.CreateViewAccessor(
glLength, iBytes)
...
End Using
End Sub
Public Function Read(lOffset As Long, iNumStruct As Integer) As T()
...
End Sub
End Class
I'm having an issue in VBA where every item in the array is being replaced every time i add something to that array.
I am attempting to go through the rows in a given range and cast every row of that into a custom class (named 'CustomRow' in below example). there is also a manager class (called 'CustomRow_Manager' below) which contains an array of rows and has a function to add new rows.
When the first row is added it works fine:
https://drive.google.com/file/d/0B6b_N7sDgjmvTmx4NDN3cmtYeGs/view?usp=sharing
however when it loops around to the second row it replaces the contents of the first row as well as add a second entry:
https://drive.google.com/file/d/0B6b_N7sDgjmvNXNLM3FCNUR0VHc/view?usp=sharing
Any ideas on how this can be solved?
I've created a bit of code which shows the issue, watch the 'rowArray' variable in the 'CustomRow_Manager' class
Macro file
https://drive.google.com/file/d/0B6b_N7sDgjmvUXYwNG5YdkoySHc/view?usp=sharing
otherwise code is below:
Data
A B C
1 X1 X2 X3
2 xx11 xx12 xx13
3 xx21 xx22 xx23
4 xx31 xx32 xx33
Module "Module1"
Public Sub Start()
Dim cusRng As Range, row As Range
Set cusRng = Range("A1:C4")
Dim manager As New CustomRow_Manager
Dim index As Integer
index = 0
For Each row In cusRng.Rows
Dim cusR As New CustomRow
Call cusR.SetData(row, index)
Call manager.AddRow(cusR)
index = index + 1
Next row
End Sub
Class module "CustomRow"
Dim iOne As String
Dim itwo As String
Dim ithree As String
Dim irowNum As Integer
Public Property Get One() As String
One = iOne
End Property
Public Property Let One(Value As String)
iOne = Value
End Property
Public Property Get Two() As String
Two = itwo
End Property
Public Property Let Two(Value As String)
itwo = Value
End Property
Public Property Get Three() As String
Three = ithree
End Property
Public Property Let Three(Value As String)
ithree = Value
End Property
Public Property Get RowNum() As Integer
RowNum = irowNum
End Property
Public Property Let RowNum(Value As Integer)
irowNum = Value
End Property
Public Function SetData(row As Range, i As Integer)
One = row.Cells(1, 1).Text
Two = row.Cells(1, 2).Text
Three = row.Cells(1, 3).Text
RowNum = i
End Function
Class module "CustomRow_Manager"
Dim rowArray(4) As New CustomRow
Dim totalRow As Integer
Public Function AddRow(r As CustomRow)
Set rowArray(totalRow) = r
If totalRow > 1 Then
MsgBox rowArray(totalRow).One & rowArray(totalRow - 1).One
End If
totalRow = totalRow + 1
End Function
Your issue is using
Dim cusR As New CustomRow
inside the For loop. This line is actually only executed once (note that when you single F8 step through the code it does not stop on that line)
Each itteration of the For loop uses the same instance of cusR. Therefore all instances of manager added to the class point to the same cusR
Replace this
For Each row In cusRng.Rows
Dim cusR As New CustomRow
with this
Dim cusR As CustomRow
For Each row In cusRng.Rows
Set cusR = New CustomRow
This explicitly instantiates a new instance of the class
I am riddling about if it is possible to conditionally switch the type of a function or variable between enum types.
Something like this:
Public Enum enmTest
eA = 1
eB = 2
eC = 3
End Enum
Public Enum enmDemo
eA = 10
eB = 50
eC = 100
End Enum
Public Function demoFunction() as enmDemo
Dim eDemo as enmDemo
ReDim eDemo as enmTest
ReDim demoFunction as enmDemo
End Function
'this does not work, but is there no way to make this work?
Public Sub test()
debug.print demoFunction().eA 'should be 1
End Sub
'this does not work, but is there no way to make this work?
Public Sub test2
Dim temp as Variant
temp = demoFunction()
debug.print temp.eB 'should be 2
End Sub
Basically the goal is to have a variable like Dim myVar which might be an enumA or enumB type. These enums might be identicall, except their values.
My guess is this won't work at no angle, because of the way VBA handles enums. But just to make sure I would like to get an explanation, as I only have a gut feeling after an hour of experimenting.
My current workaround, which hopefully demonstrates my goal:
Public Enum enmTest
eA = 1
eB = 2
eC = 3
End Enum
Public Enum enmDemo
eA = 10
eB = 50
eC = 100
End Enum
Public Function demo()
Debug.Print Str(getValues(1)(1)) 'prints 1
Debug.Print Str(getValues(2)(1)) 'prints 10
End Function
Public Function getArray(val1, val2, val3) as Variant
Dim result as Variant
ReDim result(1 to 3)
result(1) = val1
result(2) = val2
result(3) = val3
getArray = result
End Function
Public Function getValues(myInt as Integer) as Variant
If (myInt = 1) Then
getValues = getArray(enmDemo.eA, enmDemo.eB, enmDemo.eC)
Else
getValues = getArray(enmTest.eA, enmTest.eB, enmTest.eC)
End If
End Function
The best I can offer is a custom conversion Function for each Enum type. Although I would echo Dans comment: consider carefully why you want this.
' write one of these for each conversion you want
Function CastToDemo(ByRef v As enmTest) As enmDemo
Select Case v
Case enmTest.eA
CastToDemo = enmDemo.eA
Case enmTest.eB
CastToDemo = enmDemo.eB
Case enmTest.eC
CastToDemo = enmDemo.eC
End Select
End Function
' Use like this
Public Sub test()
Dim a As enmTest
Dim b As enmDemo
a = enmTest.eA
b = CastToDemo(a)
Debug.Print b
End Sub
I know we're half a year later now, but in case someone else finds this...
You could also achieve what you're looking for with classes and interfaces (using the implements keyword) instead of enumerations. It's a little more verbose than enumerations, but it's not as clunky as the conversion options, I think. If you have to use enums for some reason not included in the question, then this doesn't solve your problem. But, if you're just using the enum as a collection of named variable with numeric values, then this should do the trick:
In short, you define an interface (a class) with public read only members for eA, eB, and eC. This spells out what properties each interchangeable "enum" (class) must have.
interface:
' In a class module called IEnm
Public Property Get eA() As Long
End Property
Public Property Get eB() As Long
End Property
Public Property Get eC() As Long
End Property
Then you write another class for each specific "enum" that you're looking for - enmTest and enmDemo. These define the values of each property.
enmTest:
' In a class module called enmTest
Implements IEnm 'promises that this class defines each required property
Public Property Get IEnm_eA() As Long
IEnm_eA = 1
End Property
Public Property Get IEnm_eB() As Long
IEnm_eB = 2
End Property
Public Property Get IEnm_eC() As Long
IEnm_eC = 3
End Property
enmDemo:
' In a class module called enmDemo
Implements IEnm
Public Property Get IEnm_eA() As Long
IEnm_eA = 10
End Property
Public Property Get IEnm_eB() As Long
IEnm_eB = 50
End Property
Public Property Get IEnm_eC() As Long
IEnm_eC = 100
End Property
Here's a demo of how to use it.
Private actsLikeAnEnum As IEnm ' doesn't care if its enmTest, enmDemo,
' or enmSomethingElse
Public Function demoFunction() As IEnm ' you don't know what you'll get out
'Dim eDemo As enmDemo
'ReDim eDemo as enmTest
'ReDim demoFunction as enmDemo
Set actsLikeAnEnum = New enmTest
Set demoFunction = actsLikeAnEnum ' you could just return a new enmTest,
' but I wanted to show that the single IEnm typed variable (actsLikeAnEnum) can
' store both enmTest type objects and enmDemo type objects
End Function
Public Sub test()
Debug.Print demoFunction().eA 'prints 1
End Sub
Public Sub test2()
Dim temp As Variant
' since IEnm is an object, need to use the Set keyword
Set temp = demoFunction()
Debug.Print temp.eB 'prints 2
End Sub
'Or, if you want it to return 10 and 50....
Public Function demoFunctionTwo() As IEnm
Set actsLikeAnEnum = New enmDemo
Set demoFunctionTwo = actsLikeAnEnum
End Function
Public Sub test3()
Debug.Print demoFunctionTwo().eA 'prints 10
End Sub
Public Sub test4()
Dim temp As Variant
Set temp = demoFunctionTwo()
Debug.Print temp.eB 'prints 50
End Sub
You can set actsLikeAnEnum (which is an IEnm type object) to either a new enmDemo or an enmTest because they both implement IEnm. Then you can use actsLikeAnEnum without knowing whether there happens to be an enmDemo object or an enmTest object stored in the variable.
This question is a follow-on to VB ReDim of member field programmatically. After the arrays are dimensioned appropriately, I try to set the values of the elements, but I get an exception at run time when I try to assign the first value (MySB.AssignValues(0, "B", 0, 7.6))
System.InvalidCastException was unhandled
HResult=-2147467262
Message=Object cannot be stored in an array of this type.
Source=mscorlib
Module TestSetArray
Public Class BS
Public A As String
Public B() As Double
Public C() As Double
End Class
Public Class SB
Public MyBS() As BS
'ReadFieldString is a function that returns a string of the field name of Class BS,
'i.e., A, B or C. For test purpose, retun a constant
Public Function ReadFieldString() As String
Return "B"
End Function
'GetArrayDim is a function that returns an integer, which is the size of the array
'of that field name. For test purpose, retun a constant
Public Function GetArrayDim() As Integer
Return 2
End Function
Public Sub DimArrays()
ReDim MyBS(3)
Dim i As Integer
For i = 0 To MyBS.Length - 1
MyBS(i) = New BS()
Dim f = GetType(BS).GetField(ReadFieldString())
f.SetValue(MyBS(i), Array.CreateInstance(f.FieldType.GetElementType(), GetArrayDim()))
Next
End Sub
Public Sub AssignValues(MainIndex As Integer, TheName As String, TheIndex As Integer, TheValue As Double)
Dim f = MyBS(MainIndex).GetType.GetMember(TheName)
f.SetValue(TheValue, TheIndex)
End Sub
End Class
Sub Main()
Dim MySB As SB = New SB
MySB.DimArrays()
MySB.AssignValues(0, "B", 0, 7.6)
MySB.AssignValues(0, "B", 1, 8.2)
End Sub
End Module
Thanks in advance.
The problem is that the GetMember method returns an array of type MemberInfo, not the double array of the class. You'd probably have an easier time if you used GetField instead. You have to call GetValue and cast its result to an Array in order to use SetValue to set the value.
Public Sub AssignValues(MainIndex As Integer, TheName As String, TheIndex As Integer, TheValue As Double)
Dim f = MyBS(MainIndex).GetType().GetField(TheName)
Dim doubleArray = DirectCast(f.GetValue(MyBS(MainIndex)), Array)
doubleArray.SetValue(TheValue, TheIndex)
End Sub
or if you know that the array will always be an array of Double, you can cast it directly to that:
Public Sub AssignValues(MainIndex As Integer, TheName As String, TheIndex As Integer, TheValue As Double)
Dim f = MyBS(MainIndex).GetType().GetField(TheName)
Dim doubleArray = DirectCast(f.GetValue(MyBS(MainIndex)), Double())
doubleArray(TheIndex) = TheValue
End Sub
I have a problem with getting variable from another class and cannot understand what to do with interface`s functions which have already existed in another class.
What I have:
Form where clicking on a button I should see reversed string:
(I want to call pooraja.StringReverse which is below)
Private Sub btnPoora1_Click(sender As System.Object, e As System.EventArgs) _
Handles btnPoora1.Click
'Dim text As PrjTekstiPooraja.ITeisendused = New PrjTekstiPooraja.CtekstiPooraja
Dim text As PrjTekstiPooraja.ITeisendused = New PrjTekstiPooraja.CtekstiPooraja
Dim pooraja As PrjTekstiPooraja.ITeisendused = New PrjTekstiPooraja.CAlgrotimilinePooraja
text.strText = txtSisendTekst.Text
txtValjundTekst1.Text = pooraja.stringReverse
text.intStart = 1
text.intEnd = Len(txtSisendTekst.Text)
ascFSymbol.Text = text.ascFirstSymbol
ascLSymbol.Text = text.ascLastSymbol()
End Sub
CtekstiPooraja:
(Thiss class will be used to store data.Under data I mean strPooratavText. Data will be used in CAlgoritmilinePooraja)
Public Class CtekstiPooraja
Implements ITeisendused
Public intStartSymbol As Integer
Public intEndSymbol As Integer
Public strPooratavText As String
Private Property intEnd As Integer Implements ITeisendused.intEnd
Get
Return intEndSymbol
End Get
Set(ByVal value As Integer)
intEndSymbol = value
End Set
End Property
Private Property intStart As Integer Implements ITeisendused.intStart
Get
Return intStartSymbol
End Get
Set(ByVal value As Integer)
intStartSymbol = value
End Set
End Property
Public Function pooraText() As String Implements ITeisendused.pooraText
Return StrReverse(strPooratavText)
End Function
Public Property strText As String Implements ITeisendused.strText
Get
Return strPooratavText
End Get
Set(ByVal value As String)
strPooratavText = value
MsgBox(strPooratavText)
End Set
End Property
Public Sub teisendaText(ByRef strSisendText As String) Implements ITeisendused.teisendaText
strPooratavText = StrReverse(strSisendText)
End Sub
Public Function ascFirstSymbol() As String Implements ITeisendused.ascFirstSymbol
Return Asc(GetChar(strPooratavText, intStartSymbol))
End Function
Public Function ascLastSymbol() As String Implements ITeisendused.ascLastSymbol
Return Asc(GetChar(strPooratavText, intEndSymbol))
End Function
Public Function stringReverse() As String Implements ITeisendused.stringReverse
Return Nothing
End Function
End Class
CAlgrotimilinePooraja:
(This class will be called by form button. There I need to use stringReverse function with data from CtekstiPooraja. The problem is that everywhere is used the same interface and there is some functions and procedures from this interface which isnt necessary. I dont know what value should return these unused functions/procedures. Just using "return Nothing or return 0/ "" is bad idea, may be there is possible somehow referenceto to CTekstiPooraja functions/procedures variables")
Public Class CAlgrotimilinePooraja
Implements ITeisendused
Private x As New PrjTekstiPooraja.CtekstiPooraja
Public Function stringReverse() As String Implements ITeisendused.stringReverse
MsgBox(x.strPooratavText)
Dim i As Integer = 0
Dim j As Integer
Dim characters(j) As Char
Dim newString(j) As Char
characters = x.strPooratavText.ToCharArray()
newString = x.strPooratavText.ToCharArray()
Do While i <= j - 1
newString(i) = characters(j - 1)
newString(j - 1) = characters(i)
i += 1
j -= 1
Loop
Return newString
End Function
Public Function ascFirstSymbol() As String Implements ITeisendused.ascFirstSymbol
Return x.ascFirstSymbol()
End Function
Public Function ascLastSymbol() As String Implements ITeisendused.ascLastSymbol
Return Nothing
End Function
Public Property intEnd As Integer Implements ITeisendused.intEnd
Get
Return x.intEndSymbol
End Get
Set(ByVal value As Integer)
End Set
End Property
Public Property intStart As Integer Implements ITeisendused.intStart
Get
Return x.intStartSymbol
End Get
Set(ByVal value As Integer)
End Set
End Property
Public Function pooraText() As String Implements ITeisendused.pooraText
Return x.pooraText()
End Function
Public Property strText As String Implements ITeisendused.strText
Get
Return x.strPooratavText
End Get
Set(ByVal value As String)
End Set
End Property
Public Sub teisendaText(ByRef strSisendText As String) Implements ITeisendused.teisendaText
x.strPooratavText = StrReverse(strSisendText)
End Sub
End Class
MyInterface:
Public Interface ITeisendused
Property intStart As Integer
Property intEnd As Integer
Property strText As String
Function pooraText() As String
Function ascFirstSymbol() As String
Function ascLastSymbol() As String
Function stringReverse() As String
Sub teisendaText(ByRef strSisendText As String)
End Interface
I cannot understand how to get variable strPooratavText from CTekstiPooraja to CAlgrotimilinePooraja. Usually that instancewhich I create worked but not now. And I cannot understand what to do with already existed function and procedures in CAlgoritmilinePooraja when the same function and procedures has in another class. Maybe, it is possible to reference them somehow to existed functions/procedures in CTekstiPooraja? Could you explain me how to id, already tired to surf Internet to find a solution for it, have already try a lot.
Well, I think you have a fundamental problem with understanding interfaces. They describe data and behavior, it should be extremely rare to want to implement part of an interface.
That said, if you do want to implement part of an interface, instead of returning bogus data, throw an exception for behavior you don't implement.
Your specific problem is that CAlgoritmilinePooraja works on an instance of CtekstiPooraja, but it creates a new instance instead of using an existing one. Add
Sub New(incomingX as CtekstiPooraja)
x = incomingX
End Sub
to CAlgoritmilinePooraja. And then in your event, use....
Dim text As PrjTekstiPooraja.CtekstiPooraja = New PrjTekstiPooraja.CtekstiPooraja
text.strText = txtSisendTekst.Text
Dim pooraja As PrjTekstiPooraja.ITeisendused = New PrjTekstiPooraja.CAlgrotimilinePooraja(text)
That is the minimum change to your design that gets what you want to happen to happen but it's problably not what you should do. Other than implementing strReverse, CtekstiPooraja seems to be what you want, CAlgrotimilinePooraja looks to do just one thing, the actual string reversal.
I would move the implementation of strReverse into CtekstiPooraja, and then eliminate CAlgrotimilinePooraja.
PS I would try to stick to English for class names as well as functions and variables.