I've been working on a small project in which I attempted to use class modules through VBA to achieve results.
First Question:
The following statements are from the class module:
Private xRef As Integer
Private yRef As Integer
Private bValue As Boolean
Private NextTiles(1 To 4, 1 To 4) As Boolean
Public Property Get PreviewTiles(ByVal xRef As Integer, ByVal yRef As Integer) As Boolean
PreviewTiles(xRef, yRef) = NextTiles(xRef, yRef)
End Property
Public Property Let PreviewTiles(ByVal xRef As Integer, ByVal yRef As Integer, ByVal bValue As Boolean)
NextTiles(xRef, yRef) = bValue
End Property
In the main submodule body, the following statement exists:
Public P1, P2 As TetrisPlayer
Set P1 = New TetrisPlayer
Set P2 = New TetrisPlayer
...
P1.PreviewTiles(1, 1) = True
MsgBox P1.PreviewTiles(1, 1)
Problem 1-
This returns saying that the value of P1.PreviewTiles(1,1) False when it should be true.
Also second question:
The following code below is based on a seperate submodule, with the collection Players which includes P1 and P2 (from a separate submodule).
Sub TETRIS_Start(FormName As String)
Dim Player As TetrisPlayer
For Each Player In Players
Call TETRIS_GenerateShape(FormName, Player, True)
Next Player
End Sub
Sub TETRIS_GenerateShape(FormName As String, Player As TetrisPlayer, Start As Boolean)
...
This works more-or-less fine (although it encounters problem 1). So I tried to debug with the following statement instead:
Sub TETRIS_Start(FormName As String)
Call TETRIS_GenerateShape(FormName, P1, True)
End Sub
Problem 2 -
This results in the object P1 (publically declared, I even tried to declare it locally) not being able to pass through to the submodule TETRIS_GenerateShape.
The error message that arises is:
Compile Error: ByRef argument type mismatch.
Any suggestions?
This:
Public P1, P2 As TetrisPlayer
isn't doing what you think it is. P1 is now a variant, P2 is a TetrisPlayer. Instead, use:
Public P1 as TetrisPlayer, P2 as TetrisPlayer
Use this in TetrisPlayer instead or the current code:
Public Property Get PreviewTiles(ByVal xRef As Integer, ByVal yRef As Integer) As Boolean
PreviewTiles = NextTiles(xRef, yRef)
End Property
Public Property Let PreviewTiles(ByVal xRef As Integer, ByVal yRef As Integer, ByVal bValue As Boolean)
NextTiles(xRef, yRef) = bValue
End Property
First, set a breakpoint on MsgBox P1.PreviewTiles(1, 1) then run the code to watch what happens.
Related
I'm trying to create a class with arrays in it, and I'm having issues creating the class for it...
CLASS:
Private pST(0 To 2) As String
Public Property Get ST() As String
ST() = pST()
End Property
Public Property Let ST(value() As String) '<---- ERROR HERE
pST() = value()
End Property
CODE RUN:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.ST(0) = "test"
Debug.Print foo.ST(0)
End Sub
THE ERROR:
Compile error:
Definitions of property procedures for the same property are inconsistent, or property procedure has an optional parameter, a ParamArray, or an invalid Set final parameter.
THE QUESTION:
How can I properly initialize a class with arrays as variables?
EDIT: in relation to Mat's Mug response
CLASS CHANGED:
Private pST As Variant
Public Property Get STContent(ByVal index As Long) As String
STContent = pST(index)
End Property
Public Property Let STContent(ByVal index As Long, ByVal value As String)
pST(index) = value
End Property
Private Sub Class_Initialize()
ReDim pST(0 To 2)
End Sub
CODE RUN TO TEST:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.STContent(0) = "test" '<--- Type mismatch here
Debug.Print foo.STContent(0)
End Sub
Your getter would need to return a String() array for the types to be consistent:
Public Property Get ST() As String()
However I wouldn't recommend exposing an array like this. First because assigning typed arrays is rather painful, second because the setter (Property Let) is actually cheating here:
Public Property Let ST([ByRef] value() As String)
Unless you specify ByVal explicitly, a parameter is always passed ByRef in VBA... except there's this quirk about Property Let - the RHS/value parameter is always passed ByVal at run-time.
And arrays can only ever be passed ByRef.
Therefore, a property that gets (or assigns, actually) a whole array doesn't make much sense.
A better way would be to encapsulate the array (I'd make it a Variant though), and expose its contents (not the array itself) through an indexed property:
Private internal As Variant 'String array
'...
Public Property Get Content(ByVal index As Long) As String
Content = internal(index)
End Property
Public Property Let Content(ByVal index As Long, ByVal value As String)
internal(index) = value
End Property
You have a lot of issues there.
First, your Property Get needs to return a String array. Second, your array needs to be dynamic, or you need to rewrite the whole thing so that you pass an index value to it, otherwise there is no way to indicate which value you are passing to the array. So, for example, using a dynamic array:
Private pST() As String
Public Property Get ST() As String()
ST = pST
End Property
Public Property Let ST(value() As String)
pST() = value()
End Property
and the calling code:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
Dim asData() As String
ReDim asData(0)
asData(0) = "test"
foo.ST = asData
Debug.Print foo.ST()(0)
End Sub
Unfortunately, I couldn't be sure form the original what the intent was.
It is getting late here but give it a try. In the module:
Option Explicit
Sub Test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.AddValueToSt "test", 1
Debug.Print foo.ST(1)
End Sub
In the Class:
Option Explicit
Private pST
Public Property Get ST() As Variant
ST = pST
End Property
Public Property Let ST(value As Variant)
pST = value
End Property
Public Function AddValueToSt(value As Variant, position As Long)
pST(position) = value
End Function
Private Sub Class_Initialize()
ReDim pST(2)
End Sub
This is my way to use the Factory Method Pattern. When I say "my way", for me this pattern is translated to "Whenever some OOP requires more than 5 minutes of thinking simply add a function."
I'm designing a dynamic buffer for outgoing messages. The data structure takes the form of a queue of nodes that have a Byte Array buffer as a member. Unfortunately in VBA, Arrays cannot be public members of a class.
For example, this is a no-no and will not compile:
'clsTest
Public Buffer() As Byte
You will get the following error: "Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules"
Well, that's fine, I'll just make it a private member with public Property accessors...
'clsTest
Private m_Buffer() As Byte
Public Property Let Buffer(buf() As Byte)
m_Buffer = buf
End Property
Public Property Get Buffer() As Byte()
Buffer = m_Buffer
End Property
...and then a few tests in a module to make sure it works:
'mdlMain
Public Sub Main()
Dim buf() As Byte
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
Dim oBuffer As clsTest
Set oBuffer = New clsTest
'Test #1, the assignment
oBuffer.Buffer = buf 'Success!
'Test #2, get the value of an index in the array
' Debug.Print oBuffer.Buffer(2) 'Fail
Debug.Print oBuffer.Buffer()(2) 'Success! This is from GSerg's comment
'Test #3, change the value of an index in the array and verify that it is actually modified
oBuffer.Buffer()(2) = 27
Debug.Print oBuffer.Buffer()(2) 'Fail, diplays "3" in the immediate window
End Sub
Test #1 works fine, but Test #2 breaks, Buffer is highlighted, and the error message is "Wrong number of arguments or invalid property assignment"
Test #2 now works! GSerg points out that in order to call the Property Get Buffer() correctly and also refer to a specific index in the buffer, TWO sets of parenthesis are necessary: oBuffer.Buffer()(2)
Test #3 fails - the original value of 3 is printed to the Immediate window. GSerg pointed out in his comment that the Public Property Get Buffer() only returns a copy and not the actual class member array, so modifications are lost.
How can this third issue be resolved make the class member array work as expected?
(I should clarify that the general question is "VBA doesn't allow arrays to be public members of classes. How can I get around this to have an array member of a class that behaves as if it was for all practical purposes including: #1 assigning the array, #2 getting values from the array, #3 assigning values in the array and #4 using the array directly in a call to CopyMemory (#3 and #4 are nearly equivalent)?)"
So it turns out I needed a little help from OleAut32.dll, specifically the 'VariantCopy' function. This function faithfully makes an exact copy of one Variant to another, including when it is ByRef!
'clsTest
Private Declare Sub VariantCopy Lib "OleAut32" (pvarDest As Any, pvargSrc As Any)
Private m_Buffer() As Byte
Public Property Let Buffer(buf As Variant)
m_Buffer = buf
End Property
Public Property Get Buffer() As Variant
Buffer = GetByRefVariant(m_Buffer)
End Property
Private Function GetByRefVariant(ByRef var As Variant) As Variant
VariantCopy GetByRefVariant, var
End Function
With this new definition, all the tests pass!
'mdlMain
Public Sub Main()
Dim buf() As Byte
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
Dim oBuffer As clsTest
Set oBuffer = New clsTest
'Test #1, the assignment
oBuffer.Buffer = buf 'Success!
'Test #2, get the value of an index in the array
Debug.Print oBuffer.Buffer()(2) 'Success! This is from GSerg's comment on the question
'Test #3, change the value of an index in the array and verify that it is actually modified
oBuffer.Buffer()(2) = 27
Debug.Print oBuffer.Buffer()(2) 'Success! Diplays "27" in the immediate window
End Sub
#Blackhawk,
I know it is an old post, but thought I'd post it anyway.
Below is a code I used to add an array of points to a class, I used a subclass to define the individual points, it sounds your challenge is similar:
Mainclass tCurve
Private pMaxAmplitude As Double
Private pCurvePoints() As cCurvePoint
Public cDay As Date
Public MaxGrad As Double
Public GradChange As New intCollection
Public TideMax As New intCollection
Public TideMin As New intCollection
Public TideAmplitude As New intCollection
Public TideLow As New intCollection
Public TideHigh As New intCollection
Private Sub Class_Initialize()
ReDim pCurvePoints(1 To 1500)
ReDim curvePoints(1 To 1500) As cCurvePoint
Dim i As Integer
For i = 1 To 1500
Set Me.curvePoint(i) = New cCurvePoint
Next
End Sub
Public Property Get curvePoint(Index As Integer) As cCurvePoint
Set curvePoint = pCurvePoints(Index)
End Property
Public Property Set curvePoint(Index As Integer, Value As cCurvePoint)
Set pCurvePoints(Index) = Value
End Property
subclass cCurvePoint
Option Explicit
Private pSlope As Double
Private pCurvature As Double
Private pY As Variant
Private pdY As Double
Private pRadius As Double
Private pArcLen As Double
Private pChordLen As Double
Public Property Let Slope(Value As Double)
pSlope = Value
End Property
Public Property Get Slope() As Double
Slope = pSlope
End Property
Public Property Let Curvature(Value As Double)
pCurvature = Value
End Property
Public Property Get Curvature() As Double
Curvature = pCurvature
End Property
Public Property Let valY(Value As Double)
pY = Value
End Property
Public Property Get valY() As Double
valY = pY
End Property
Public Property Let Radius(Value As Double)
pRadius = Value
End Property
Public Property Get Radius() As Double
Radius = pRadius
End Property
Public Property Let ArcLen(Value As Double)
pArcLen = Value
End Property
Public Property Get ArcLen() As Double
ArcLen = pArcLen
End Property
Public Property Let ChordLen(Value As Double)
pChordLen = Value
End Property
Public Property Get ChordLen() As Double
ChordLen = pChordLen
End Property
Public Property Let dY(Value As Double)
pdY = Value
End Property
Public Property Get dY() As Double
dY = pdY
End Property
This will create a tCurve with 1500 tCurve.Curvepoints().dY (for example)
The trick is to get the index process correct in the main class !
Good luck !
Not the most elegant solution, but modeling from the code you provided...
In clsTest:
Option Explicit
Dim ArrayStore() As Byte
Public Sub AssignArray(vInput As Variant, Optional lItemNum As Long = -1)
If Not lItemNum = -1 Then
ArrayStore(lItemNum) = vInput
Else
ArrayStore() = vInput
End If
End Sub
Public Function GetArrayValue(lItemNum As Long) As Byte
GetArrayValue = ArrayStore(lItemNum)
End Function
Public Function GetWholeArray() As Byte()
ReDim GetWholeArray(LBound(ArrayStore) To UBound(ArrayStore))
GetWholeArray = ArrayStore
End Function
And in mdlMain:
Sub test()
Dim buf() As Byte
Dim bufnew() As Byte
Dim oBuffer As New clsTest
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
oBuffer.AssignArray vInput:=buf
Debug.Print oBuffer.GetArrayValue(lItemNum:=2)
oBuffer.AssignArray vInput:=27, lItemNum:=2
Debug.Print oBuffer.GetArrayValue(lItemNum:=2)
bufnew() = oBuffer.GetWholeArray
Debug.Print bufnew(0)
Debug.Print bufnew(1)
Debug.Print bufnew(2)
Debug.Print bufnew(3)
End Sub
I added code to pass the class array to another array to prove accessibility.
Even though VBA won't allow us to pass arrays as properties, we can still use Functions to pick up where properties fall short.
When I define the size of an integer array using a variable I get the error: "IndexOutOfRangeException was unhandled". However, if I just put the same value as the variable that I used, it works.
I'll explain it in comments better below:
Public Class Form1
Dim test As Test
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
test = New Test(5) 'the length property is test is 5
test.AddToList()
End Sub
End Class
Public Class Test
Dim _length As Integer
Public Property length() As Integer
Get
Return _length
End Get
Set(ByVal value As Integer)
_length = value
End Set
End Property
Dim _magnitude(length, 2) As Integer 'Size is length, which should be equal to 5. If I remove length and just put 5, it works fine.
Public Property magnitude As Integer(,)
Get
Return _magnitude
End Get
Set(ByVal value As Integer(,))
_magnitude = value
End Set
End Property
Public Sub New(ByVal lengthp As Integer)
length = lengthp 'Sets 5 to the length property.
End Sub
Public Sub AddToList()
magnitude(4, 0) = 4 'Operates on the magnitude property. This is where the error is located.
Debug.Print(magnitude(4, 0))
End Sub
End Class
Hopefully you guys understand what I'm asking.
Private fields are initialized prior to the constructor. When you instantiate the class, _magnitude is initialized before length is set, so what you get is the equivalent of Dim _magnitude(0, 2) As Integer.
Try changing your declaration to something like:
Dim _magnitude(,) As Integer
'...
Public Sub New(ByVal lengthp As Integer)
length = lengthp
ReDim _magnitude(lengthp, 2) As Integer
End Sub
You also talk about length, so you should keep in mind that you're specifying the upper bound of the array, not the length.
The Dim statement for the _magnitude member variable occurs before the constructor. Change your code as follows:
Dim _magnitude(,) As Integer '<<Changed. Don't set the bounds here, just declare the variable
Public Property magnitude As Integer(,)
Get
Return _magnitude
End Get
Set(ByVal value As Integer(,))
_magnitude = value
End Set
End Property
Public Sub New(ByVal lengthp As Integer)
length = lengthp 'Sets 5 to the length property.
ReDim _magnitude(length, 2) '<<Added. Set the bounds AFTER the length property has been set
End Sub
Upon selecting a Question ID in the combo box the relating question should then appear in the text box. I am unsure how to get this to work though. I receive an error "Value of type......cannot be converted to string" on retrieveQuestion(). Any help is appreciated, thankyou.
Private Sub cmbQuestion_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbQuestion.SelectedIndexChanged
txtExistingQuestion.Text = retrieveQuestion() 'Add question, relevant to Question ID, to text box, DO I NEED .ToString?????????????????
loaded = True
End Sub
Public Function retrieveQuestion() As List(Of Question) 'Retrieves selected question into text box
Dim typeList As New List(Of Question)
Dim Str As String = "SELECT Question_ID, Question_Text FROM Question WHERE Question_ID =" & cmbQuestion.SelectedValue
Try
Using conn As New SqlClient.SqlConnection(DBConnection)
conn.Open()
Using cmdQuery As New SqlClient.SqlCommand(Str, conn)
Using drResult As SqlClient.SqlDataReader = cmdQuery.ExecuteReader()
While drResult.Read
typeList.Add(New Question(drResult("Question_ID"), drResult("Question_Text")))
End While
End Using 'Automatically closes connection
End Using
End Using
Catch ex As Exception
MsgBox("Question List Exception: " & ex.Message & vbNewLine & Str)
End Try
Return typeList
End Function
Public Class Question 'defining one club within class
Public Sub New(ByVal questionID As Integer, ByVal questionText As String)
mQuestionID = questionID 'm is for member of the class
mQuestionText = questionText
End Sub
Private mQuestionID As String = ""
Private mQuestionText As String = ""
Public Property QuestionID() As String
Get
Return mQuestionID
End Get
Set(ByVal value As String)
mQuestionID = value
End Set
End Property
Public Property QuestionText() As String
Get
Return mQuestionText
End Get
Set(ByVal value As String)
mQuestionText = value
End Set
End Property
End Class
Your issue is this line:
mQuestionID = questionID
In your class you have defined this:
Private mQuestionID As String = ""
But in your constructor, you are saying that questionID should be an Integer, like this:
Public Sub New(ByVal questionID As Integer, ByVal questionText As String)
You need to change your backing variable in your class (mQuestionID) to be an Integer, like this:
Private mQuestionID As Integer
This will also necessitate a change to the property syntax for QuestionID, like this:
Public Property QuestionID() As Integer
Get
Return mQuestionID
End Get
Set(ByVal value As Integer)
mQuestionID = value
End Set
End Property
Your error is originated by the return value of retrieveQuestion declared as a List(Of Question) but then you try to set the text property of a TextBox (and there is no way to convert automatically a List(Of Question) to a string)
So you could write something like this to extract the text of the first question in the list
Dim qList = retrieveQuestion()
if qList.Count > 0 then
txtExistingQuestion.Text = qList(0).QuestionText
loaded = True
End If
Of course, if your query returns zero or just one question, then there is no need to return a List(Of Question) and you can change the retrieveQuestion method to return just a Question or Nothing
Public Function retrieveQuestion() As Question
Dim questionResult As Question = Nothing
......
Using drResult As SqlClient.SqlDataReader = cmdQuery.ExecuteReader()
if drResult.Read() then
questionResult = New Question(drResult("Question_ID"), _
drResult("Question_Text")))
End if
End Using
....
return questionResult
End Function
Dim question = retrieveQuestion()
if question IsNot Nothing then
txtExistingQuestion.Text = question.QuestionText
loaded = True
End If
However, all the comments about string and integer conversion happening automatically on your code are really an alarm bell. You should strive to avoid this kind of conversion because they render your code weak and prone to misterious errors. Switch to Option Strinct On on your project properties and prepare yourself to a lot of conversion fixing.
I am working in VB.net where i have class like below:
Public Class vertex
Public wasVisited As Boolean
Public name, type As String
Public x_pos, y_pos As Double
Public Sub New(ByVal x_pos As Double, ByVal y_pos As Double, ByVal name As Integer, ByVal type As String)
Me.x_pos = x_pos
Me.y_pos = y_pos
Me.name = name
Me.type = type
wasVisited = False
End Sub
End Class
I have object of some other class named as "graph" where in constructor of graph class I am calling constructor of vertex class.
I have array of vertex class: Public vertices() As vertex
And redim vertices(2000): resizing array again for some reason.
Now, when i loop the array to check empty value it throws an error:
Object reference not set to an instance of an object. (Since value contains "nothing")
even though i am checking like this,
If (vertices(i).name) Is Nothing Then
Exit For
End If
How can i check empty element of array?
Since you seem to want your collection be dynamic, a List(Of vertex) would serve you better. that along with a default New() constructor and you can add, remove, sort, search, whatever you need. To check for any empty value you can use If Vertices(i).name = "" then
Public Class vertex
Public wasVisited As Boolean
Public name, type As String
Public x_pos, y_pos As Double
Public Sub New()
wasVisited = False
name = ""
type = ""
x_pos = 0
y_pos = 0
End Sub
Public Sub New(ByVal x_pos As Double, ByVal y_pos As Double, ByVal name As String, ByVal type As String)
Me.x_pos = x_pos
Me.y_pos = y_pos
Me.name = name
Me.type = type
wasVisited = False
End Sub
End Class
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim Vertices As New List(Of vertex)
For I = 0 To 99
Vertices.Add(New vertex())
Vertices(I).name = "Test" + I.ToString
Next
End Sub
What's the size of vertices() before the redim operation ? If it's less than 2000, then the added elements will be Nothing right after the array enlargement, therefore when you try to access the name property of vertices(i) for values of i that go beyond the initial array size you're actually trying to dereference a null object reference.
You either need to check that vertices(i) IsNot Nothing before testing for the value of its properties or make sure every element of the array is assigned a new vertex object.
If vertices(i) Is Nothing OrElse vertices(i).name Is Nothing Then
Exit For
End If
Here's a thread on vbforums about a similar problem: http://www.vbforums.com/showthread.php?546668-RESOLVED-Redim-array-of-objects
Have you tried:
If Not vertices Is Nothing AndAlso Not vertices(i) Is Nothing _
AndAlso Not vertices(i).name Is Nothing Then
Dim value as string= vertices(i).name
End If