开云体育

ctrl + shift + ? for shortcuts
© 2025 开云体育

VB: Code Sample, Level Intermediate....Dynamic ReqMarket Array Management


marinindextrader
 

The following code has been posted as a BAS module in the files
section:



It is the topmost item on the list

This module and the form code with it, will dynamically manage an
array of all tickers called. It will update the array with tickPrice
and tickSize events, and gives functions for deleting tickers that
are no longer needed.

It will not allow the duplicate call of a ticker. If you use
identical tickers in several locations this will cut overhead

The use of filter arrays to post tickPrice and tickSize eliminate the
need for any conditional statments in the tickPrice tickSize TWS
subs. One line of code keeps the array up to date.

The cancel market data sub has some flags particular to my program.
They can be eliminated and the sub can be passed the symbol as an
arguement from elswhere in your program...

Scott
Yahoo TWS API

The top commented section goes in the form that holds the TWS API,
the rest would be put in a module.


code follows:


''REQ MARKET DATA SUB ON MAIN FORM
'Private Sub reqMarketData()
'
' ' contract description vars
' Dim TWSsymbol As String, TWSsecType As String, TWSexpiry As String
' Dim TWSstrike As Single, TWSright As String, TWSexchange As String
' Dim TWScurency As String
'
' Dim Mirror(7) As Variant 'static; only passed in a sub call
' Dim Update() As Variant 'must be dynamic for assignment
'
' ReDim Update(1)
'
' 'assign security description
' TWSsymbol = m_newSymbol
' TWSsecType = cmbSecType.Text
' TWSexpiry = expiryAlphaToNum(cmbYear.Text & cmbMonth.Text)
' TWSstrike = 0
' TWSright = ""
' TWSexchange = cmbExchange.Text
' TWScurency = ""
'
' 'assign values to the Mirror array, id ommitted; will be assigned
' Mirror(1) = TWSsymbol: Mirror(2) = TWSsecType: Mirror(3) =
TWSexpiry
' Mirror(4) = TWSstrike: Mirror(5) = TWSright: Mirror(6) =
TWSexchange: Mirror(7) = TWScurency
'
' 'pass Mirror out to module level function
' Update = Fxn_UpdateReqMarketArray(Mirror)
'
' 'evaluate results and call new ticker if needed
' If Update(1) Then
' Call Tws1(0).reqMktData(Update(0), TWSsymbol, TWSsecType,
TWSexpiry, TWSstrike, _
' TWSright, TWSexchange, TWScurency)
'
' 'this sub goes out onto the web and fetches Open, High, Low,
Close
' 'using a Winsock Connection
' Call Init_GetClose(UCase(TWSsecType), LCase(TWSsymbol),
TWSexpiry)
'
' 'the results are added to the master tick array
' 'you can find this code in the files section as GetClose.zip
' '
' End If
'
' 'release the Mirror array
' Erase Mirror
'
'End Sub
'
''CANCEL MARKET DATA SUB ON MAIN FORM
'Private Sub cancelMktData()
'
' Dim bInUseTab As Boolean
' Dim bInUseGrid As Boolean
' Dim id As Long
'
' 'these two functions are specific to my program...similar
functions would be
' 'crafted for your use if required; or you could pass the old
symbol into the
' 'sub as an arguement; either way they are optional...you just
need a symbol
'
' bInUseTab = Fxn_CheckForTabUse(m_oldSymbol) 'checks if still used
(Tabs)
' bInUseGrid = Fxn_CheckForGridUse(m_oldSymbol) 'checks if still
used (Grid Pages)
'
' 'if no longer needed then remove it
' If Not bInUseTab And Not bInUseGrid Then
'
' 'get the id# from the Req Market Array
' id = Fxn_GetOldSymbolID(m_oldSymbol)
'
' 'remove from the Req Market Array by id#
' Call Remove_ReqMarketArray(id)
'
' 'cancel the data stream using the id#
' Tws1(0).cancelMktData id
'
' End If
'
'End Sub
'
''TICKPRICE SUB ON MAIN FORM
'Private Sub Tws1_tickPrice(Index As Integer, ByVal id As Long, ByVal
tickType As Long, _
' ByVal price As Single)
'
' Call Update_ReqMarketArrayPrice(Index, id, tickType, price)
'
'End Sub
'
''TICKSIZE SUB ON MAIN FORM
'Private Sub Tws1_tickSize(Index As Integer, ByVal id As Long, ByVal
tickType As Long, _
' ByVal size As Long)
'
' Call Update_ReqMarketArraySize(Index, id, tickType, size)
'
'End Sub

'THE ABOVE CODE GOES ON THE FORM WHERE YOUR TWS API MODULE IS

'MODULE THAT MAINTAINS THE ARRAYS
Option Explicit

Private arrReqMarket() As Variant 'this is the Master Working array
Private arrIndex() As Integer 'this array keep matches id's with an
index value
Private arrTranslator(5) As Integer 'this array is a filter for
tickTypes

'SUB TO INITIALIZE THE VARIABLES
Sub Init_VarsReqMarketMod()

'called on form load
ReDim arrReqMarket(19, 0)

'the Value of this translator array is evident in the tickPrice
and tickSize subs
'tickPrice bid-last-ask
arrTranslator(1) = 8: arrTranslator(4) = 9: arrTranslator(2) = 10
'tickSize, bid-last-ask
arrTranslator(0) = 11: arrTranslator(5) = 12: arrTranslator(3) = 13

End Sub

'FUNCTION TO ADD ELEMENTS TO ARRAY
Function Fxn_UpdateReqMarketArray(ByRef Mirror() As Variant) As
Variant()

Dim iTemp As Integer
Dim bMatch As Boolean
Dim tempArray(1) As Variant

Static id As Integer 'make static to remember

'searches the array and if mirror doesnt match adds an element
For iTemp = 0 To UBound(arrReqMarket, 2)
If arrReqMarket(1, iTemp) = Mirror(1) Then
If arrReqMarket(2, iTemp) = Mirror(2) Then
If arrReqMarket(3, iTemp) = Mirror(3) Then
If arrReqMarket(4, iTemp) = Mirror(4) Then
If arrReqMarket(5, iTemp) = Mirror(5) Then
If arrReqMarket(6, iTemp) = Mirror(6) Then
If arrReqMarket(7, iTemp) = Mirror(7) Then
bMatch = True
tempArray(0) = -1
tempArray(1) = False
'assignment..don't add
Fxn_UpdateReqMarketArray = tempArray
Debug.Print "perfect match"
End If
End If
End If
End If
End If
End If
End If
Next iTemp
'add a ticker if above is false
If Not bMatch Then 'add array element
'incrament id by 1
id = id + 1
arrReqMarket(0, UBound(arrReqMarket, 2)) = id
'copy over the Mirror
For iTemp = 1 To UBound(Mirror)
arrReqMarket(iTemp, UBound(arrReqMarket, 2)) = Mirror(iTemp)
Next iTemp
'Redim the ReqMarket array in preperation for next ticker
ReDim Preserve arrReqMarket(UBound(arrReqMarket), UBound
(arrReqMarket, 2) + 1)

'update the index finder array
Call Update_IndexArray

'optional...just want to make sure the memory is released
Erase tempArray

'assign results
tempArray(0) = id
tempArray(1) = True

'send back to ReqMarket Sub
Fxn_UpdateReqMarketArray = tempArray

End If

End Function

'SUB TO REMOVE TICKERS
Sub Remove_ReqMarketArray(ByVal id As Integer)

Dim iTemp As Integer, iTemp2 As Integer
Dim tempArray As Variant

'prep the tempArray for duty
ReDim tempArray(UBound(arrReqMarket), 0)

'copy over all tickers that dont match the id to be removed
For iTemp = 0 To UBound(arrReqMarket, 2)
If id <> arrReqMarket(0, iTemp) Then
For iTemp2 = 0 To UBound(arrReqMarket)
tempArray(iTemp2, UBound(tempArray, 2)) = arrReqMarket
(iTemp2, iTemp)
Next iTemp2
'add a slot and loop again
ReDim Preserve tempArray(UBound(arrReqMarket), UBound
(tempArray, 2) + 1)
End If
Next iTemp

'assign the results and remove the tempArray
arrReqMarket = tempArray
Erase tempArray

'update the index finder array
Call Update_IndexArray

End Sub

'KEEPS THE INDEX FINDER ARRAY UP TO DATE
Sub Update_IndexArray()

Dim iTemp As Integer, MaxID As Integer, id As Integer
Dim tempArray() As Integer

'find the highest id number
For iTemp = 0 To UBound(arrReqMarket, 2)
If arrReqMarket(0, iTemp) > MaxID Then
MaxID = arrReqMarket(0, iTemp)
End If
Next iTemp

'dimension the temp array
ReDim tempArray(MaxID)

'match the id with index
For iTemp = 0 To UBound(arrReqMarket, 2)
id = arrReqMarket(0, iTemp)
tempArray(id) = iTemp
Next iTemp

'assign index and remove the tempArray
arrIndex = tempArray
Erase tempArray

End Sub

'FEEDS THE REQ MARKET ARRAY WITH PRICE INFO
Sub Update_ReqMarketArrayPrice(ByVal Index As Integer, ByVal id As
Integer, ByVal tickType As _
Integer, ByVal price As Single)

'update the Req Market array with each tickPrice; automatically
arrReqMarket(arrTranslator(tickType), arrIndex(id)) = price


End Sub

'FEEDS THE REQ MARKET ARRAY WITH SIZE INFO
Sub Update_ReqMarketArraySize(ByVal Index As Integer, ByVal id As
Integer, ByVal tickType As Integer, _
ByVal size As Integer)

'update the Req Market array with each tickSize; automatically
arrReqMarket(arrTranslator(tickType), arrIndex(id)) = size

End Sub

'FINDS THE SYMBOL ID GIVEN THE SYMBOL
Function Fxn_GetOldSymbolID(f_oldSymbol) As Integer

Dim iTemp As Integer

'go find the id#
'match with symbol
For iTemp = 0 To UBound(arrReqMarket, 2) - 1
If arrReqMarket(1, iTemp) = f_oldSymbol Then
'assignment
Fxn_GetOldSymbolID = arrReqMarket(0, iTemp)
Exit For 'bail out
End If
Next iTemp

'this Finder function could take an array as an arguement if you
want an
'all points match similiar to the Fxn_UpdateReqMarketArray
function above

End Function