Listing 1 - VB5
Function GetList() As ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Dim objContext As ObjectContext
Set objContext = GetObjectContext()
On Error GoTo GetListError
' Open the connection
cn.Open mszDSN' Get the list of vendors
rs.CursorLocation = adUseClientBatch
rs.Open mszSQLGETVENDORS, cn, adOpenUnspecified, _
adLockUnspecified, adCmdUnspecified
' Setup the recordset to return
Set GetList = rs
' Disconnect the recordset
Set rs.ActiveConnection = Nothing
' Close the connection
cn.Close
objContext.SetComplete
Exit Function
GetListError:
' Raise a generic error and pass the description on
objContext.SetAbort
Err.Raise vbObjectError + 100, mszCLASSNAME, _
Err.Description
End Function
Listing 2 - VB5
Sub LoadVendorList()
Dim rs As ADOR.Recordset
Dim clsVend As New CVendor
' Clear the listbox
lstVendors.Clear
' Get all the vendors and
Set rs = clsVend.GetList
' Loop through and add vendors
Do While Not rs.EOF
' Add the vendor name
lstVendors.AddItem rs("Name")
' Store the VendorID
lstVendors.ItemData(lstVendors.NewIndex) = _
rs("VendorID")
' Get the next vendor
rs.MoveNext
Loop
End Sub
Listing 3 - VB5
Private Sub CFindInterface_FindByID(lID As Long)
Dim iCount As Integer
' Refresh the list
LoadProductList
' Loop through and look for specified vendor
For iCount = 0 To lstProducts.ListCount - 1
' Did we find it?
If lstProducts.ItemData(iCount) = lID Then
' Select that one
lstProducts.ListIndex = iCount
' Bail out
Exit For
End If
Next
End Sub
Listing 4 - VB5
Private Sub lstRelatedProduct_DblClick()
Dim clsFind As New CFindInterface
' Get a find interface
Set clsFind = Parent.Frame.GetPanel( _
"Products").Control.object
' Find the vendor
clsFind.FindByID lstRelatedProduct.ItemData( _
lstRelatedProduct.ListIndex)
' Show the control
Parent.Frame.SetActivePanel "Products"
End Sub
Listing 5 vb5
If bNew Then
iVendorID = clsVend.Add(txtName, txtAddress1, _
txtAddress2, txtCountry, txtCity, _
txtState, txtZip, txtPostalCode, mskPhone, _
txtFax, txtEmail, txtURL, mskTollFree, _
txtContactName, mskContactPhone, txtContactEmail)
bNew = False
Else
iVendorID = lstVendors.ItemData( _
lstVendors.ListIndex)
clsVend.Update iVendorID, txtName, _
txtAddress1, txtAddress2, txtCountry, _
txtCity, txtState, txtZip, txtPostalCode, _
mskPhone, txtFax, txtEmail, txtURL, _
mskTollFree, txtContactName, _
mskContactPhone, txtContactEmail
End If
Listing 6 - VB5
Private Sub CToolbarInterface_DeleteItem()
Dim clsProd As New CProduct
' Check if there is already a new record pending
If bNew Then
' Ask if they want to save
If MsgBox( _
"Do you want to save the new vendor?", _
vbYesNo) = vbYes Then
' Attempt a save
If Not SaveItem Then
' If it fails, bail so user can correct mistake
Exit Sub
End If
End If
bNew = False
End If
' Delete the item
clsProd.Delete lstProducts.ItemData( _
lstProducts.ListIndex)
' clear the controls
ClearControls
' Reload the list of products
LoadProductList
End Sub
Private Sub CToolbarInterface_NewItem()
' Check if there is already a new record pending
If bNew Then
' Ask if they want to save
If MsgBox("Do you want to save the new vendor?", _
vbYesNo) = vbYes Then
' Attempt a save
If Not SaveItem Then
' If it fails, bail so user can correct mistake
Exit Sub
End If
End If
End If
' Clear the controls
ClearControls
' Deselect the current vendor
lstProducts.ListIndex = -1
' Set the new flag
bNew = True
End Sub
Private Sub CToolbarInterface_RefreshItem()
Dim lProductID As Long
Dim iCount As Integer
' If a product is selected store it's productid
If lstProducts.ListIndex >= 0 Then
' Store the ID
lProductID = lstProducts.ItemData( _
lstProducts.ListIndex)
Else
' Else store indicator that no product
' was selected
lProductID = -1
End If
' Reload the product list
LoadProductList lProductID
End Sub
Private Sub CToolbarInterface_SaveItem()
' Call the save routine
SaveItem
End Sub
Private Sub lstDownloads_DblClick()
Dim clsFind As New CFindInterface
' Get a find interface
Set clsFind = Parent.Frame.GetPanel( _
"Downloads").Control.object
' Find the vendor
clsFind.FindByID lstDownloads.ItemData( _
lstDownloads.ListIndex)
' Show the control
Parent.Frame.SetActivePanel "Downloads"
End Sub
Listing 7 - VB5
Private Sub btnDelete_Click(Index As Integer)
Dim tbtemp As CToolbarInterface
Set tbtemp = Frame.GetActivePanel.Control.object
tbtemp.DeleteItem
Set tbtemp = Nothing
End Sub
Private Sub btnNew_Click()
Dim tbtemp As CToolbarInterface
Set tbtemp = Frame.GetActivePanel.Control.object
tbtemp.NewItem
Set tbtemp = Nothing
End Sub
Private Sub btnRefresh_Click(Index As Integer)
Dim tbtemp As CToolbarInterface
Set tbtemp = Frame.GetActivePanel.Control.object
tbtemp.RefreshItem
Set tbtemp = Nothing
End Sub
Private Sub btnSave_Click()
Dim tbtemp As CToolbarInterface
Set tbtemp = Frame.GetActivePanel.Control.object
tbtemp.SaveItem
Set tbtemp = Nothing
End Sub |
