BorlandTalk.com

LarryJ · Guest

I am writing In BCB6.0 and need to create a COM link to a program which has
all the sample code in VB. I need someone with knowledge of COM and VB to
create the interface in BCB6.0. Below is the VB sample code that contains a
lot of the function calls that I need to have setup in BCB6.0. If you think
you can do this type of job email me at patrick456 (AT) austin (DOT) rr.com and we
can discuss payment and more details.

Thanks
Patrick

Dim SFServ As cTC2005

Dim Wordens() As Long 'Holds the worden numbers for the current list

'The following hold criteria values for the current list
Dim Rankings() As Long
Dim HighestPossibleVals() As Single
Dim LowestPossibleVals() As Single

Dim DataID As String
Dim InStartUp As Boolean

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long

Private Sub Form_Load()

'This section just sets up the columns in our Data Sheet list
'----
Dim Ttab(3) As Long
Ttab(0) = 125
Ttab(1) = 157
Call SendMessage(listDataSheet.hwnd, &H192, 2, Ttab(0))
'----

Me.Caption = "TC2000Dev Example - Connecting to TC2000"
StartTimer.Enabled = True 'Let timer start the program so the form will
show itself
'Go to StartTimer_Timer event to follow along
End Sub

Private Sub StartTimer_Timer()
StartTimer.Enabled = False 'We don't need the timer anymore
StartUp
End Sub

Private Sub StartUp()
'Put up the hour glass
Screen.MousePointer = 11

'We will now attemp to make our connection to the tc2005 data
'Unlike the cTC2000 interface we now allow early bound connections

'There are a couple of things that can go wrong here
'1. We may not be able to create the object TC2000Dev.cTC2000 most
likely
' because it does not exist on the machine, or is not registered
' in this case(In vb) you will get an error 429 or 91(See StartServer)
' when trying to instanciate the object
'2. If we do create an object of type TC2000Dev.cTC2000 we need to check
' the TCEnabled property to ensure that it started correctly.
'
'If all this succeeds then we are ready to go

If StartServer Then 'Start server will create the SFServ object

If Not SFServ.TCEnabled Then 'Check to make sure that our connection
is good
MsgBox "Unable to connect to TC2005"
Else
InitScreen 'All is well so fill the screen
End If
Debug.Print SFServ.StockIsActive(10225)
End If
'Take the hourglass down
Screen.MousePointer = 0

End Sub

Private Function StartServer() As Boolean

StartServer = True

On Error GoTo ErrorCreating
Set SFServ = New cTC2005

Exit Function

ErrorCreating:
If Err.Number = 429 Or Err.Number = 91 Then
'Unable to start or find SF3rdDev
MsgBox "Error"
StartServer = False
Else
'Other error ?
StartServer = False
End If
End Function

Private Sub InitScreen()

Dim Version As Long
Dim Revision As Long

CheckVersion Version, Revision

'Show the version and revision of TC2000Dev in the caption
Me.Caption = "TC2000Dev Example Connected to version " & Version & "." &
Revision

InStartUp = True 'We use this boolean to keep the chart list from
filling while
' we are changing list indexes around

LayoutDataSheet 'Sets up the listview used for the data sheet

LayoutChart 'Moves the chart labels into position

'Fill some combos
FillListNames

If cmbSortName.Visible Then FillSortNames

FillCriteriaList

InStartUp = False

'Fills symbols list with all available symbols
FillSymbolsForList

End Sub

Private Sub CheckVersion(Version As Long, Revision As Long)

'The calls GetVersion And GetRevision were added in version 0, revision
36
'So if the calls themself fail we have an early version
'Otherwise we get the version and revision and pass it back
On Error GoTo EarlyVersion
Version = SFServ.GetVersion
Revision = SFServ.GetRevision

Exit Sub

EarlyVersion:
Version = 0
Revision = 0

End Sub

Private Sub LayoutDataSheet()

'lvDataSheet.ColumnHeaders.Clear
'Put list view in Column mode
'lvDataSheet.View = lvwReport

'Add some columns
'lvDataSheet.ColumnHeaders.Add , , "Criterion Name", 1700
'lvDataSheet.ColumnHeaders.Add , , "Rank/Choice Name", 1000
'lvDataSheet.ColumnHeaders.Add , , "Value Range", 2700

End Sub

Private Sub LayoutChart()

Dim ChartBottom As Long
Dim ChartRight As Long
Dim HalflblWidth As Long
Dim HalflblHeight As Long

ChartBottom = pInd.Top + pInd.Height
ChartRight = pInd.Left + pInd.Width
HalflblWidth = lblChart(0).Width / 2
HalflblHeight = lblChart(0).Height / 2

'Position chart labels around the chart picture boxes

lblChart(0).Move pInd.Left - HalflblWidth, ChartBottom + 20
lblChart(1).Move pInd.Left + (pInd.Width / 2) - HalflblWidth, ChartBottom +
20
lblChart(2).Move ChartRight - HalflblWidth, ChartBottom + 20

lblChart(3).Move ChartRight + 20, pChart.Top - HalflblHeight
lblChart(4).Move ChartRight + 20, pChart.Top + (pChart.Height / 2) -
HalflblHeight
lblChart(5).Move ChartRight + 20, pChart.Top + pChart.Height - HalflblHeight

End Sub

Private Sub FillListNames()

Dim aList As StockList
Dim Lists As Collection
Dim tmp As String

cmbListName.Clear
cmbListName.AddItem "(None)"
cmbListName.ListIndex = 0

Set Lists = SFServ.StockLists

'Add all list names and a description of their type to the List Name
combo
For Each aList In Lists
tmp = getListTypeName(aList)
cmbListName.AddItem aList.Name + " - " + tmp
Next aList

End Sub

Private Function getListTypeName(aList As StockList)

'Converts a ListType number to a more meaningful description

getListTypeName = ""

If aList.ListType = eComponentType Then
getListTypeName = "Component WatchList"
ElseIf aList.ListType = eFilterType Then
getListTypeName = "Easy Scan"
ElseIf aList.ListType = eIndustryType Then
If aList.IsParentList Then
getListTypeName = "Media General Main"
Else
getListTypeName = "Media General Sub"
End If
ElseIf aList.ListType = eISharesComponent Then
getListTypeName = "IShares Component List"
ElseIf aList.ListType = ePersonalListType Then
getListTypeName = "Personal WatchList"
ElseIf aList.ListType = eSystemType Then
getListTypeName = "System WatchList"
End If

End Function

Private Sub FillSortNames()

Dim Criterias As Collection
Dim aCriteria As Criteria

'This call returns an Collection of criteria that can be applied to a
chart list
Set Criterias = SFServ.Criterias

cmbSortName.Clear
'Add an option to not specify a sort
cmbSortName.AddItem "(None)"
cmbSortName.ListIndex = 0

'Add all the sort names to the Sort Name combo
For Each aCriteria In Criterias
cmbSortName.AddItem aCriteria.Name
Next aCriteria

End Sub

Private Sub FillCriteriaList()

Dim Criterias As Collection
Dim aCriteria As Criteria

'This call returns an Collection of criteria that can be applied to a
chart list
Set Criterias = SFServ.Criterias

cmbCriteria.Clear
'Add an option to not specify a sort
cmbCriteria.AddItem "(None)"
cmbCriteria.ListIndex = 0

'Add all the sort names to the Sort Name combo
For Each aCriteria In Criterias
cmbCriteria.AddItem aCriteria.Name
Next aCriteria

End Sub

Private Sub FillSymbolsForList()

If InStartUp Then Exit Sub
Dim aList As StockList
Dim symbols As ListContents
Dim DisplayCriteria As Criteria
Dim i As Long
Screen.MousePointer = 11

'Check to see if a list has been selected else fill with all symbols
If cmbListName.ListIndex > 0 Then
'A value of "(None)" was entered in the list as index 0 so we can
treat the list index
'as the index of the list we want
Set aList = SFServ.StockLists(cmbListName.ListIndex)
Else
Set aList = SFServ.ListFromGUID(SFServ.LISTGUIDALLITEMSINSYSTEM)
End If
'Get the sybmols for this list
Set symbols = aList.ListContents
'Check to see if a sort has been selected, if so sort the list
If cmbSortName.ListIndex > 0 Then
Dim aCrit As Criteria
Set aCrit = SFServ.Criterias(cmbSortName.ListIndex)
aCrit.SortListContents symbols, False
End If

'If a criteria is selected then we get the data passing in the result
array of worden
'numbers we got from which ever call we just used to get a list

If cmbCriteria.ListIndex > 0 Then
Set DisplayCriteria = SFServ.Criterias(cmbCriteria.ListIndex)
End If

lstChartList.Clear
'Make the chart invisible to speed filling of the list
lstChartList.Visible = False

On Error GoTo NoSymbols ' This will trap an error in the ubound call if
the array passed
' back was empty

'If there was a criterion selected the we fill the list with the symbol
and ranking
'if not we just fill with the symbols

If Not DisplayCriteria Is Nothing Then
For i = 1 To symbols.Count
lstChartList.AddItem symbols.Symbol(i) + vbTab +
DisplayCriteria.DisplayValue(symbols.WordenNumber(i))
'Set the worden number in the item data field for easy lookup
later
lstChartList.ItemData(lstChartList.NewIndex) =
symbols.WordenNumber(i)
Next i
Else
For i = 1 To symbols.Count
lstChartList.AddItem symbols.Symbol(i)
'Set the worden number in the item data field for easy lookup
later
lstChartList.ItemData(lstChartList.NewIndex) =
symbols.WordenNumber(i)
Next i
End If

NoSymbols:
lstChartList.Visible = True
Screen.MousePointer = 0

End Sub

Private Sub FillDataSheet()

lstInfo.Clear

'If there is no symbol selected we get out of here
If lstChartList.ListIndex < 0 Then Exit Sub
Dim Symbol As String
Dim WordenNumber As Long

WordenNumber = lstChartList.ItemData(lstChartList.ListIndex)
If WordenNumber = 0 Then Exit Sub

lstInfo.AddItem SFServ.CompanyName(WordenNumber)
Select Case SFServ.Exchange(WordenNumber)
Case 0
lstInfo.AddItem "No Exchange"
Case 1
lstInfo.AddItem "NYSE"
Case 2
lstInfo.AddItem "Amex"
Case 3
lstInfo.AddItem "NASDAQ"
End Select

If SFServ.Optionable(WordenNumber) = True Then
lstInfo.AddItem "Optionable"
Else
lstInfo.AddItem "Not Optionable"
End If

Dim Criterias As Collection
Dim aCriteria As Criteria

listDataSheet.Clear

Set Criterias = SFServ.Criterias
For Each aCriteria In Criterias
'Debug.Print aCriteria.Name
listDataSheet.AddItem aCriteria.Name + vbTab +
aCriteria.DisplayValue(WordenNumber)
Next aCriteria

End Sub

Private Sub ShowOutput()

Dim i As Long

'If this is true then the chart is selected so make it visible and hide
the data sheet
'and call ShowChart
If optView(0).Value = True Then

pChart.Visible = True
pInd.Visible = True
For i = 0 To 5
lblChart(i).Visible = True
Next i
listDataSheet.Visible = False
lstInfo.Visible = False

ShowChart
'Other wise show the data sheet and call FillDataSheet
Else

pChart.Visible = False
pInd.Visible = False
For i = 0 To 5
lblChart(i).Visible = False
Next i
listDataSheet.Visible = True
lstInfo.Visible = True

FillDataSheet
End If

End Sub

Private Sub ShowChart()

Dim Symbol As String
Dim WordenNumber As Long
If lstChartList.ListIndex = -1 Then Exit Sub
WordenNumber = lstChartList.ItemData(lstChartList.ListIndex)
If WordenNumber = 0 Then Exit Sub

Dim i As Long
Dim Max As Single
Dim Min As Single
Dim Count As Long

Screen.MousePointer = 11

On Error GoTo NoData ' if the call to get data fails or the ubound call
fails
'we can leave here

'Get the prices for the selected symbol
'The call fills 6 arrays we pass in with Open,High,Low,Close,Volume,and
Date

'Change last argument to change number of days returned if there are
less days
'than requested, all available data will be returned
'Also a value of 0 will allways return all data

Dim Prices As PriceHistory
Set Prices = SFServ.PriceHistory(WordenNumber, 350)
'Loop through and find max and min values so we can scale the chart
Min = Prices.LowPrice(1)
Max = Prices.HighPrice(1)
For i = 1 To Prices.Count
If Prices.HighPrice(i) > Max Then Max = Prices.HighPrice(i)
If Prices.LowPrice(i) < Min Then Min = Prices.LowPrice(i)
Next i

'Set the scale of the picture box for the chart and set the color a nice
TC2000 green
pChart.ScaleHeight = Min - Max
pChart.ScaleTop = Max
pChart.ScaleLeft = Prices.Count
pChart.ScaleWidth = -Prices.Count
pChart.ForeColor = QBColor(10)

'Clear chart and indicator picture boxes
pChart.Cls
pInd.Cls

'Loop through and draw nice price bars
For i = 1 To Prices.Count
pChart.Line (i, Prices.LowPrice(i))-(i, Prices.HighPrice(i))
pChart.Line (i, Prices.ClosePrice(i))-(i - 0.7,
Prices.ClosePrice(i))
Next i

'This will set the chart labels for the current price,date scale
SetLabels Prices.DateNumber(1), Prices.DateNumber(Val(Prices.Count /
2)), Prices.DateNumber(Prices.Count), Max, Min

'If BOP or MoneyStream are selected paint them
If chkBOP Then ShowBOP WordenNumber, Prices.Count
If chkMS Then ShowMoneyStream WordenNumber, Prices.Count
pChart.Refresh
NoData:

Screen.MousePointer = 0

End Sub

Private Sub SetLabels(MinDate As Long, MidDate As Long, MaxDate As Long,
MaxVal As Single, MinVal As Single)

'Set the caption of the chart labels
'The dates are returned as a long with the format yyyymmdd so we must format
first
lblChart(0).Caption = FormatTCDate(MaxDate)
lblChart(1).Caption = FormatTCDate(MidDate)
lblChart(2).Caption = FormatTCDate(MinDate)

lblChart(3).Caption = Format(MaxVal, "0.00")
lblChart(4).Caption = Format(MinVal + ((MaxVal - MinVal) / 2), "0.00")
lblChart(5).Caption = Format(MinVal, "0.00")
End Sub

Private Function FormatTCDate(aDateLong As Long) As String

'Converts long of format yyyymmdd to string of format mm/dd/yyyy
Dim tmp As String
tmp = Format(aDateLong)
FormatTCDate = Mid(tmp, 5, 2) + "/" + Right(tmp, 2) + "/" + Left(tmp, 4)

End Function

Private Sub ShowBOP(Worden As Long, Count As Long)

Dim BopValues() As Single
Dim i As Long
Dim Max As Single
Dim Min As Single

'This call fills the array we pass in with the BOP values
'for the specified number of days
Dim IndValues As IndicatorHistory
Set IndValues = SFServ.BopValues(Worden, Count + 1)

'BOP is allways scaled from 100 to -100 so we set our picture box
'scale to that
Min = -100
Max = 100

pInd.ScaleHeight = Min - Max
pInd.ScaleTop = Max
pInd.ScaleLeft = IndValues.Count
pInd.ScaleWidth = -IndValues.Count
pInd.ForeColor = QBColor(10)

'Loop through values and draw a line from 0 to the value in the
'appropriate color
For i = 1 To IndValues.Count
If IndValues.Value(i) > 30 Then
pInd.Line (i, IndValues.Value(i))-(i, 0)
ElseIf IndValues.Value(i) < -30 Then
pInd.Line (i, IndValues.Value(i))-(i, 0), QBColor(12)
Else
pInd.Line (i, IndValues.Value(i))-(i, 0), QBColor(14)
End If
Next i

End Sub

Private Sub ShowMoneyStream(Worden As Long, Count As Long)

Dim MSValues() As Single
Dim i As Long
Dim Max As Single
Dim Min As Single

'This call fills the array we pass in with the BOP values
'for the specified number of days
Dim IndValues As IndicatorHistory
Set IndValues = SFServ.MoneyStreamValues(Worden, Count + 1)

'Find the min and max values and scale the picture box accordingly
Min = IndValues.Value(1)
Max = IndValues.Value(1)
For i = 1 To IndValues.Count
If IndValues.Value(i) > Max Then Max = IndValues.Value(i)
If IndValues.Value(i) < Min Then Min = IndValues.Value(i)
Next i

pInd.ScaleHeight = Min - Max
pInd.ScaleTop = Max
pInd.ScaleLeft = IndValues.Count
pInd.ScaleWidth = -IndValues.Count
pInd.ForeColor = QBColor(14)

'Draw moneystream
For i = 2 To IndValues.Count
pInd.Line (i - 1, IndValues.Value(i - 1))-(i, IndValues.Value(i))
Next i

End Sub

Private Sub cmbCriteria_Click()
'If a new criteria is selected we need to update the list
'It is not nessesary to get a new list, only the new criteria values
'but I am lazy and this is just a demo
FillSymbolsForList
End Sub

Private Sub cmbListName_Click()
'Refill the list of symbols
FillSymbolsForList
End Sub

Private Sub cmbSortName_Click()
'Refill the list of symbols
FillSymbolsForList
End Sub

Private Sub lstChartList_Click()
'A new symbol has been selected so we need to update the chart or the
data sheet
ShowOutput
End Sub

Private Sub optView_Click(Index As Integer)
'The selected output has changed so we show the new one
'If the new selection is chart then we enable the bop and MoneyStream
'check boxes
ShowOutput
If Index = 0 Then
chkBOP.Enabled = True
chkMS.Enabled = True
Else
chkBOP.Enabled = False
chkMS.Enabled = False
End If
End Sub

Private Sub chkBOP_Click()
'The option to show BOP has changed so we will repaint

ShowOutput
End Sub

Private Sub chkMS_Click()
'The option to show MoneyStream has changed so we will repaint

ShowOutput
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

'Can't help but add the old spacebar

If KeyCode = vbKeySpace Then
If lstChartList.ListIndex + 2 < lstChartList.ListCount Then
lstChartList.ListIndex = lstChartList.ListIndex + 1
Else
lstChartList.ListIndex = 0
End If
ElseIf KeyCode = vbKeyBack Then
If lstChartList.ListIndex > 0 Then
lstChartList.ListIndex = lstChartList.ListIndex - 1
Else
lstChartList.ListIndex = lstChartList.ListCount - 1
End If
End If

End Sub

'These are some calls that are not included in this example but info
'is available in the documentation

'GetCompanyNames
'GetCriteriaValuesForRanking
'GetSymbolsForChartListEX
'StockIsActive
'Symbol
'WordenNumFromSymbol