If i have my own class in VBScript:
class TestClass
public var1
public var2
end class
I can instantiate and populate as such:
dim classVar
set classVar = new TestClass
classVar.var1 = "test1"
classVar.var2 = "test2"
My question is, is there a one-liner for instantiating and populating? My hope is to be able to do this while adding the class to a list:
dim listVar
set listVar = CreateObject( "System.Collections.ArrayList" )
listVar.add new TestClass ("test" "test2")
Is this possible in VBScript? Thanks!
Nope, VBScript/VB6/VBA do not support constructors for classes.
You can use a Factory:
function MakeTestClass(a, b, c)
set MakeTestClass = new TestClass
MakeTestClass.var1 = a
MakeTestClass.var2 = b
end function
listVar.add MakeTestClass(11, 22, 33)
Or one (or more) special init (member) functions returning Me:
>> Class cC
>> Private n
>> Public Function init(p)
>> n = p
>> Set init = Me
>> End Function
>> Public Function toString()
>> toString = "cC object: " & n
>> End Function
>> End Class
>> WScript.Echo New cC.init(4711).toString()
>>
cC object: 4711
>>
Related
Maybe it's a trivial question but I would like to know how to access a constant property within the class contructor or a class function in octave. Let's make an example:
classdef Example % < FatherClass
% read-only protected properties
properties (Constant=true, Access=protected)
all_levels = {"A","B","C","D"};
endproperties
% protected properties
properties(Access=protected)
level = 'D';
output = '.';
endproperties
methods(Access=public)
function obj = Example (level,outputfilepath)
if any(strcmp(all_levels,level))
obj.level = level;
else
error ("possible levels are: A B C D");
endif
obj.output = outputfilepath
endfunction
endmethods
end
running this class example I receive the error:
error: 'all_levels' undefined near line 12, column 12
error: called from
Example at line 12 column 13
So, I've tried something like
if any(strcmp(obj.all_levels,level))
obj.level = level;
With the same result, also defining a getter:
methods (Static = true)
function lvs = gel_levels()
lvs = all_levels
endfunction
endmethods
...
methods(Access=public)
function obj = Example (obj,level,outputfilepath)
all_levels = get_levels()
% disp(all_levels)
if any(strcmp(all_levels,level))
obj.level = level;
else
error ("possible levels are: A B C D");
endif
obj.output = outputfilepath
endfunction
endmethods
Sorry but I'm quite new to octave and I haven't found any example about this. What I'm trying to accomplish is a simple class variable
The question is a bit confusing, as different attempts seem to be using different parts, but in general I think your problem is that you are not passing the object as a formal parameter in the method.
It is also not clear if you are trying to modify the object "in-place", or trying to generate a new one ... but in any case remember that modifying objects in place is not possible (unless inheriting from the 'handle' object). Therefore the typical thing you're supposed to do is: pass the object in as the first input as you're supposed to do with class method definitions, modify it, return it, and then when you're using this method in your calling workspace, capture this object (typically in a variable by the same name as the called object in the calling workspace) via assignment.
This works for me:
%% in Example.m
classdef Example
% read-only protected properties
properties( Constant=true, Access=protected )
all_levels = {"A", "B", "C", "D"};
endproperties
% protected properties
properties( Access = protected )
level = 'D';
output = '.';
endproperties
methods( Access = public )
function obj = Logging( obj, level, outputfilepath )
valid_level_choice = any( strcmp( obj.all_levels, level ) );
if valid_level_choice, obj.level = level;
else, error( "possible levels are: A B C D" );
endif
obj.output = outputfilepath;
endfunction
function get_level( obj )
fprintf( "The level is %s\n;", obj.level );
endfunction
endmethods
endclassdef
%% In your console session
E = Example();
E.get_level()
%> The level is D
E = E.Logging( 'A', './' );
E.get_level()
%> The level is A
UPDATE
Updated code given the revised question / comments.
This works for me in octave 7.1.0
%% in Example.m
classdef Example % < FatherClass
% read-only protected properties
properties (Constant=true, Access=protected)
all_levels = {"A","B","C","D"};
endproperties
% protected properties
properties(Access=protected)
level = 'D';
output = '.';
endproperties
methods(Access=public)
% Constructor
function obj = Example (level,outputfilepath)
valid_choice = any(strcmp(obj.all_levels,level));
if valid_choice, obj.level = level;
else, error ("possible levels are: A B C D");
endif
obj.output = outputfilepath;
endfunction
% Remaining Methods
function get_level( obj ), fprintf( "The level is %s\n", obj.level ); endfunction
function change_all_levels( obj, C ), obj.all_levels = C; endfunction
endmethods
end
%% octave session
octave:1> E = Example('A', '.');
octave:2> E.get_level()
%> The level is A
octave:3> E.change_all_levels( {'this', 'should', 'not', 'work' } );
%> error: subsasgn: cannot assign constant property: all_levels
%> error: called from
%> change_all_levels at line 25 column 66
In LibreOffice Basic sub I use a bunch of uno properties in an array. Which is the simplest Unostructure or UnoService that I must "embed" them, in order to use the getByName "function"?
Example:
dim props(1) as new com.sun.star.beans.PropertyValue
props(0).Name = "blahblah1"
props(0).Value = "blahblah1Value"
props(1).Name = "blahblah2"
props(1).Name = 3000
I want to be able to use something like:
b = props.getByName("blahblah2").Value
or something like (assuming I "assigned" them in a structure-like-object called "somestruct") :
b = somestruct.getprops.getByName("blahblah2").Value
As I understand that this can be done by creating a "UnoService" which supports the getByName and then, somehow, assigning these props to this service
Which is the "lightest" such service?
(I mean the service that uses less resources)
Thanks in advance.
Really supporting the interface XNameAccess is not as easy. The services which implement this interface are supposed using this interface for existing named properties, not for own created ones.
But you can use the service EnumerableMap to achieve what you probably want.
Example:
sub testEnumerableMap
serviceEnumerableMap = com.sun.star.container.EnumerableMap
oEnumerableMap = serviceEnumerableMap.create("string", "any")
oEnumerableMap.put("blahblah1", "blahblah1Value")
oEnumerableMap.put("blahblah2", 3000)
oEnumerableMap.put("blahblah3", 1234.67)
msgbox oEnumerableMap.get("blahblah1")
msgbox oEnumerableMap.get("blahblah2")
msgbox oEnumerableMap.get("blahblah3")
'msgbox oEnumerableMap.get("blahblah4") 'will throw error
msgbox oEnumerableMap.containsKey("blahblah2")
msgbox oEnumerableMap.containsValue(3000)
if oEnumerableMap.containsKey("blahblah4") then
msgbox oEnumerableMap.get("blahblah4")
end if
end sub
But starbasic with option Compatible is also able supporting Class programming like VBA does.
Example:
Create a module named myPropertySet. Therein put the following code:
option Compatible
option ClassModule
private aPropertyValues() as com.sun.star.beans.PropertyValue
public sub setProperty(oProp as com.sun.star.beans.PropertyValue)
bUpdated = false
for each oPropPresent in aPropertyValues
if oPropPresent.Name = oProp.Name then
oPropPresent.Value = oProp.Value
bUpdated = true
exit for
end if
next
if not bUpdated then
iIndex = ubound(aPropertyValues) + 1
redim preserve aPropertyValues(iIndex)
aPropertyValues(iIndex) = oProp
end if
end sub
public function getPropertyValue(sName as string) as variant
getPropertyValue = "N/A"
for each oProp in aPropertyValues
if oProp.Name = sName then
getPropertyValue = oProp.Value
exit for
end if
next
end function
Then within a standard module:
sub testClass
oPropertySet = new myPropertySet
dim prop as new com.sun.star.beans.PropertyValue
prop.Name = "blahblah1"
prop.Value = "blahblah1Value"
oPropertySet.setProperty(prop)
prop.Name = "blahblah2"
prop.Value = 3000
oPropertySet.setProperty(prop)
prop.Name = "blahblah3"
prop.Value = 1234.56
oPropertySet.setProperty(prop)
prop.Name = "blahblah2"
prop.Value = 8888
oPropertySet.setProperty(prop)
msgbox oPropertySet.getPropertyValue("blahblah1")
msgbox oPropertySet.getPropertyValue("blahblah2")
msgbox oPropertySet.getPropertyValue("blahblah3")
msgbox oPropertySet.getPropertyValue("blahblah4")
end sub
LibreOffice Basic supports the vb6 Collection type.
Dim coll As New Collection
coll.Add("blahblah1Value", "blahblah1")
coll.Add(3000, "blahblah2")
MsgBox(coll("blahblah1"))
Arrays of property values are the only thing that will work for certain UNO interfaces such as dispatcher calls. If you simply need a better way to deal with arrays of property values, then use a helper function.
Sub DisplayMyPropertyValue
Dim props(0 To 1) As New com.sun.star.beans.PropertyValue
props(0).Name = "blahblah1"
props(0).Value = "blahblah1Value"
props(1).Name = "blahblah2"
props(1).Name = 3000
MsgBox(GetPropertyByName(props, "blahblah1"))
End Sub
Function GetPropertyByName(props As Array, propname As String)
For Each prop In props
If prop.Name = propname Then
GetPropertyByName = prop.Value
Exit Function
End If
Next
GetPropertyByName = ""
End Function
XNameAccess is used for UNO containers such as Calc sheets. Normally these containers are obtained from the UNO interface, not created.
oSheet = ThisComponent.Sheets.getByName("Sheet1")
May UNO objects support the XPropertySet interface. Normally these are also obtained from the UNO interface, not created.
paraStyleName = cellcursor.getPropertyValue("ParaStyleName")
It may be possible to create a new class in Java that implements XPropertySet. However, Basic uses helper functions instead of class methods.
I think the serviceEnumerableMap is the answer (so far). Creating the values and searching them was much faster then creating props in a dynamic array and searching them with a for loop in basic.
(I do not "dare" to use "option Compatible", although I was a big fun of VB6 and VBA, because of the problems in code that maybe arise).
I used this code to test time in a form:
SUB testlala(Event)
TESTPROPS(Event)
' TESTENUM(Event)
MSGBOX "END OF TEST"
END SUB
SUB TESTENUM(Event)
DIM xcounter AS LONG
'b = now()
serviceEnumerableMap = com.sun.star.container.EnumerableMap
oEnumerableMap = serviceEnumerableMap.create("string", "any")
FOR xcounter= 0 TO 10000
oEnumerableMap.put("pr" & FORMAT(xcounter,"0000"), xcounter -10000)
NEXT
'b=now()-b
b = now()
FOR xcounter = 1 TO 5000
lala = Int((9000 * Rnd) +1)
g =oEnumerableMap.get("pr" & FORMAT(lala,"0000"))
'MSGBOX GetValueFromName(props,"pr" & FORMAT(xcounter,"0000"))
NEXT
b=now()-b
MSGBOX b*100000
END SUB
SUB TESTPROPS(Event)
DIM props()
DIM xcounter AS LONG
'b = now()
FOR xcounter= 0 TO 10000
AppendProperty(props,"pr" & FORMAT(xcounter,"0000"), xcounter -10000)
NEXT
'b=now()-b
b = now()
FOR xcounter = 1 TO 5000
lala = Int((9000 * Rnd) +1)
g = GetValueFromName(props,"pr" & FORMAT(lala,"0000"))
'MSGBOX GetValueFromName(props,"pr" & FORMAT(xcounter,"0000"))
NEXT
b=now()-b
MSGBOX b*100000
END SUB
REM FROM Andrew Pitonyak's OpenOffice Macro Information ------------------
Sub AppendToArray(oData(), ByVal x)
Dim iUB As Integer 'The upper bound of the array.
Dim iLB As Integer 'The lower bound of the array.
iUB = UBound(oData()) + 1
iLB = LBound(oData())
ReDim Preserve oData(iLB To iUB)
oData(iUB) = x
End Sub
Function CreateProperty(sName$, oValue) As com.sun.star.beans.PropertyValue
Dim oProperty As New com.sun.star.beans.PropertyValue
oProperty.Name = sName
oProperty.Value = oValue
CreateProperty() = oProperty
End Function
Sub AppendProperty(oProperties(), sName As String, ByVal oValue)
AppendToArray(oProperties(), CreateProperty(sName, oValue))
End Sub
I'm currently trying to implement a Clark & Wright Savings Heurisitc in VBA, but I'm currently facing some problem. I'm fairly new to VBA, and this error (91) keeps apearing on similar situations, which lead me to believe I'm missing some crucial knowledge. Next I present you the code:
Public Sub CWsavings()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim aux As Integer
Dim d As Integer
Dim r As Integer
Dim Cu(200) As customer
Dim De(12) As Depot
For i = 1 To 200
Set Cu(i) = New customer
Cu(i).custID = i
Cu(i).longitude = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 2)
Cu(i).latitude = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 3)
Cu(i).lt = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 4)
Cu(i).et = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 5)
Cu(i).weekdemand = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 6)
Cu(i).peakdemand = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 7)
Cu(i).D1 = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 8)
Cu(i).D2 = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 9)
Next i
For j = 1 To 12
Set De(j) = New Depot
De(j).depotID = j
De(j).Dname = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 13)
De(j).latitude = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 14)
De(j).longitude = ThisWorkbook.Sheets("Folha1").Cells(i + 1, 15)
De(j).ncust = ThisWorkbook.Sheets("Results").Cells(j, 7)
De(j).nroute = 0
For k = 1 To De(j).ncust
aux = ThisWorkbook.Sheets("Results").Cells(j + 1, 10 + k)
Call De(j).SetCustomer(Cu(aux), k)
Next k
Next j
For d = 1 To 12
Dim M(30, 30) As Double
Dim maxsav As Double
Dim maxpos(2) As Integer
Dim connorder(676, 2) 'order of connections for routing
Dim it As Integer
it = 0
For i = 1 To De(d).ncust
For j = 1 To De(d).ncust
M(i, j) = CalcSavings(De(d), De(d).customer(i), De(d).customer(j)) ' error here
Next j
Next i
itbegin:
maxsav = 0
maxpos(1) = 0
maxpos(2) = 0
For i = 1 To De(d).ncust
For j = 1 To De(d).ncust
If i <> j Then
If M(i, j) > maxsav Then
maxsav = M(i, j)
maxpos(1) = i
maxpos(j) = j
End If
End If
Next j
Next i
it = it + 1
connorder(it, 1) = maxpos(1)
connorder(it, 2) = maxpos(2)
If it < De(d).ncust * De(d).ncust - ncust Then
M(maxpos(1), maxpos(2)) = 0
GoTo itbegin
End If
Next d
End Sub
Public Function CalcSavings(d As Depot, C1 As customer, C2 As customer)
Dim id As Double
Dim dj As Double
Dim ij As Double
id = DeptDist(C1, d)
dj = DeptDist(C2, d)
ij = CustDist(C1, C2)
CalcSavings = id + dj - ij
End Function
The class Depot:
Public depotID As Integer
Public Dname As String
Public latitude As Double
Public longitude As Double
Private customers(200) As customer
Public ncust As Integer
Private routes(500) As route
Public nroute As Integer
Public Sub addcust(C As customer)
ncust = ncust + 1
Set customers(ncust) = C
End Sub
Public Sub addroute(R As route)
nroute = Me.nroute + 1
Set routes(Me.nroute) = R
End Sub
Public Property Get customer(i As Integer) As customer
customer = customers(i)
End Property
Public Sub SetCustomer(C As customer, i As Integer)
Set customers(i) = C
End Sub
Public Property Get route(i As Integer) As route
route = routes(i)
End Property
Public Sub SetRoute(R As route, i As Integer)
Set routes(i) = R
End Sub
(Class depot Updated)
And the class Customer:
Public custID As Integer
Public latitude As Double
Public longitude As Double
Public lt As Double
Public et As Double
Public weekdemand As Integer
Public peakdemand As Integer
Public D1 As Integer
Public D2 As Integer
I'm sorry for the long post, any help would be appreciated.
Final answer...
VERY ODDLY, (not that odd, when you really look at it, but) you need to use Set even in your Get properties. I guess the reason behind this is because you're returning an object, and even though that object may already exist, you're not going to use that very object. A copy is used instead and Set becomes vital to initialize that copy.
For example, here's what your "get customer" should look like :
Public Property Get customer(i As Integer) As customer
Set customer = customers(i)
End Property
I guess it all makes sense; your array is private, and therefore you wouldn't want to pass the exact object that is contained inside that array, or it'd be counter-logic.
I think I found it... again...!
Try this :
Public Sub SetCustomer(C As customer, i As Integer)
Set customers(i) = C
End Sub
Notice customer(i) was replaced by customers(i)
EDIT : Deleted previous answer, as I was mostly fishing.
Example code for illustration:
Option Explicit
Dim obj: Set obj = New Foo
WScript.Echo "EnvFlags(0)=" & obj.EnvFlags(0) 'EnvFlags(0)=False
WScript.Echo Join(obj.EnvFlags(-1), ",") 'False,False,False
On Error Resume Next 'enabled just for facility's sake
obj.EnvFlags 0, True '<< Why this NOT work?...
If Err Then WScript.Echo Err.Number, Err.Description
'> 450 Wrong number of arguments or invalid property assignment
On Error Goto 0
Class Foo
Private mEnvFlags
Public Property Let EnvFlags(nIndex, bValue)
If vbBoolean <> VarType(bValue) Then Exit Property
If nIndex >= 0 And nIndex <= 2 Then
mEnvFlags(nIndex) = bValue
End If
End Property
Public Property Get EnvFlags(nIndex)
If nIndex < 0 Or nIndex > 2 Then
EnvFlags = mEnvFlags
Else
EnvFlags = mEnvFlags(nIndex)
End If
End Property
Private Sub Class_Initialize
mEnvFlags = Array(False, False, False)
End Sub
End Class
How to fix that? (and as bonus - why it`s happen?) Thanks
Reference the documentation for Property Let. A Property Let is not the same as a subroutine call. The proper syntax is
obj.EnvFlags(0) = True
I know there is a way to pass class variables in vb.net as such:
Module Module1
Sub Main()
' Declare an instance of the class and assign a value to its field.
***Dim c1 As Class1 = New Class1()***
c1.Field = 5
Console.WriteLine(c1.Field)
' Output: 5
' ByVal does not prevent changing the value of a field or property.
ChangeFieldValue(***c1***)
Console.WriteLine(***c1.Field***)
' Output: 500
' ByVal does prevent changing the value of c1 itself.
ChangeClassReference(c1)
Console.WriteLine(c1.Field)
' Output: 500
Console.ReadKey()
End Sub
Public Sub ChangeFieldValue(***ByVal cls As Class1***)
cls.Field = 500
End Sub
Public Sub ChangeClassReference(***ByVal cls As Class1***)
cls = New Class1()
cls.Field = 1000
End Sub
Public Class Class1
Public Field As Integer
End Class
End Module
However when I try to emulate the same procedure in vba, it doesn't work.
is it possible to do in vba (for Excel)?
Try the following.
Sub Main()
Dim c1 As New Class1
c1.Field = 5
Debug.Print c1.Field
changeFieldValue c1
Debug.Print c1.Field
changeClassReference c1
Debug.Print c1.Field
End Sub
Public Sub changeClassReference(cls As Class1)
Set cls = New Class1
cls.Field = 1000
End Sub
Public Sub changeFieldValue(cls As Class1)
cls.Field = 500
End Sub
You'll need to add a new class module with the following code:
Public Field As Long