jwcolby
jwcolby at colbyconsulting.com
Fri May 16 11:19:12 CDT 2008
Drew,
You will have to comment out or fake up a logerr function as called in
my error handlers.
The system works just fine, it just bogs down for large data sets.
> That shouldn't matter John, please post the code for your callback
> function.
'---------------------------------------------------------------------------------------
' Module : clsCallBack
' Author : jwcolby
' Date : 5/15/2008
' Purpose : This class implements the call back logic for multiple
combo controls in a
' single callback. It is used in conjunction with basCallback.
'
' The concept is that we will load arrays of data using the names of
queries passed in to
' mInit. As a combo uses a callback, the name of the combo will be
checked in cboCallback
' and if it is different than the last time cboCallback was called then
mInit of this class
' will be called passing in the name of the query used to fill the array.
'
' mInit will first attempt to load an existing array from a collection
of arrays, keyed
' on the query name. If the array is found in the collection we are
done. If it is not
' found then we will open the recordset and load the data into the
array, and then store
' the array into the collection for the next time.
'
' Over time, every query ever used for a combo (that uses the callback)
will eventually
' be cached in the collection.
'
' This provides a couple of advantages:
'
' 1) A query which directly using a query holds open a connection to the
BE so we will
' use fewer connections.
' 2) Loading the data out of the BE requires time as the form opens.
Since the recordsets
' will eventually all cache, the forms should open faster.
'
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
Const cstrModule As String = "clsCallBack"
Private mdb As DAO.Database
Private strCtlName As String
Private intRows As Integer
Private intColumns As Integer
Private varDisplayData() As Variant
Private varRetVal As Variant
Private mblnInitialized As Boolean
Private mblnEnd As Boolean
Private mInstanceCnt As Integer 'how many combos are using this class
instance?
Private mcolCboData As Collection 'Holds the arrays of data for
combos, keyed on the query name
Private Sub Class_Initialize()
Set mdb = dbDAO
Set mcolCboData = New Collection
End Sub
Private Sub Class_Terminate()
Set mdb = Nothing
Set mcolCboData = Nothing
End Sub
'---------------------------------------------------------------------------------------
' Procedure : mInit
' Author : jwcolby
' Date : 5/15/2008
' Purpose : Loads the data from a query into an array and stores the
array into a
' collection. The recordset only loads once, then is
found in the
' collection after that.
'---------------------------------------------------------------------------------------
'
Public Function mInit(strQryName As String)
On Error GoTo Err_mInit
'
'Attempt to get the query data out of the collection
On Error Resume Next
varDisplayData = mcolCboData(strQryName)
'
'If not found then load from a recordset
If Err <> 0 Then
Err.Clear
On Error GoTo Err_mInit
Dim rst As DAO.Recordset
Set rst = mdb.OpenRecordset(strQryName)
With rst
rst.MoveLast
rst.MoveFirst
varDisplayData = rst.GetRows(rst.RecordCount)
End With
'
'Once the data is loaded into the array, store in the
collection, keyed on strQryName
mcolCboData.Add varDisplayData, strQryName
End If
'
'Get the row and column count for the callback function
intRows = UBound(varDisplayData, 2) + 1
intColumns = UBound(varDisplayData, 1) + 1
Exit_mInit:
On Error Resume Next
If Not (rst Is Nothing) Then rst.Close: Set rst = Nothing
Exit Function
Err_mInit:
LogErr Err.Number, Err.Description, Erl, cstrModule, ""
Resume Exit_mInit
Resume 0 '.FOR TROUBLESHOOTING
End Function
Property Get pInitialized() As Boolean
pInitialized = mblnInitialized
End Property
Property Get pEnd() As Boolean
pEnd = mblnEnd
End Property
'---------------------------------------------------------------------------------------
' Procedure : mCallBack
' Author : jwcolby
' Date : 5/15/2008
' Purpose : This is the actual callback function used to fill the combo.
'---------------------------------------------------------------------------------------
'
Public Function mCallBack(control As control, ID As Variant, _
row As Variant, column As Variant, _
code As Variant) As Variant
On Error GoTo Err_mCallBack
If control.Name <> strCtlName Then
'Debug.Print strCtlName & ": Trips: " & lngTripCnt
strCtlName = control.Name
mInit "q" & strCtlName
End If
Select Case code
Case acLBGetFormat 'Code 7
' Return formatting information here.
Case acLBGetValue 'Code 6
' Return data to be displayed here.
varRetVal = varDisplayData(column, row)
Case acLBInitialize 'Code 0
' Any necessary initialization code goes here.
' For example: determine number or rows and number
' of columns, save these values in the intRows and
' intColumns variables, and re-dimension the Static array
' varDisplayData().
'Debug.Print control.Name & ": Code=" & code
'mInit "q" & control.Name
mInstanceCnt = mInstanceCnt + 1
varRetVal = True
Case acLBOpen 'Code 1
' Return a unique id value here.
varRetVal = Timer
Case 2
'Debug.Print "code: " & code
Case acLBGetRowCount 'Code 3
' Return the number of rows here.
varRetVal = intRows
Case acLBGetColumnCount 'Code 4
' Return the number of columns here.
varRetVal = intColumns
Case acLBGetColumnWidth 'Code 5
' Return the column widths here.
varRetVal = -1
Case acLBClose
Case acLBEnd 'Code 9
' Perform any necessary clean up here.
mInstanceCnt = mInstanceCnt - 1
If mInstanceCnt = 0 Then
mblnEnd = True
Else
mblnEnd = False
End If
Case Else
'Debug.Print "code: " & code
End Select
mCallBack = varRetVal
Exit_mCallBack:
Exit Function
Err_mCallBack:
LogErr Err.Number, Err.Description, Erl, cstrModule, ""
Resume Exit_mCallBack
Resume 0 '.FOR TROUBLESHOOTING
End Function
John W. Colby
www.ColbyConsulting.com
Drew Wutka wrote:
> That shouldn't matter John, please post the code for your callback
> function.
>
> I've had large listboxes which are callback based too, which work fine.
>
> Drew