标题: 给大家一个好东东，看你识不识货 [打印本页] 作者: gnoy 时间: 2002-9-17 22:17 标题: 给大家一个好东东，看你识不识货 Private Function valueList(ctl As Control, _
varID As Variant, _
lngRow As Long, _
lngCol As Long, _
intCode As Integer) As Variant
Dim varRetVal As Variant
Dim strField As String
Dim strSQL As String
Dim strList As String
Dim intLoopRow As Integer
Dim intLoopCol As Integer
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Static svarArray() As Variant
Static sintRows As Integer
Static sintCols As Integer
On Error GoTo Proc_err
Select Case intCode
Case acLBInitialize
On Error Resume Next
intLoopRow = UBound(svarArray)
If Err <> 0 Then
On Error GoTo Proc_err
'populate the customer recordset
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
'this gets stored values from the only
'local table to allow flexibility
.ConnectionString = CurrentProject.Path & "\data.mdb" 'should be changed
.Open
End With
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = cnn
.Source = "select usysuser.userid,usysuser.username from usysuser" 'should be changed
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockReadOnly
.Open , , , , adCmdText
.MoveLast
sintRows = .RecordCount
.MoveFirst
sintCols = .Fields.Count
End With 'rst
Set cnn = Nothing
ReDim svarArray(sintRows, sintCols)
For intLoopRow = 0 To sintRows - 1
svarArray(intLoopRow, 0) = rst(0)
svarArray(intLoopRow, 1) = rst(1)
' MsgBox rst(0) & rst(1)
rst.MoveNext
Next
rst.Close
End If
varRetVal = True
Case acLBOpen '1
'return a unique ID code
varRetVal = Timer
Case acLBGetRowCount '3
' Return number of rows
varRetVal = sintRows
Case acLBGetColumnCount '4
' Return number of fields (columns)
varRetVal = sintCols
Case acLBGetColumnWidth '5
'return the column widths or
'-1 for the default width for the column
' varRetVal = -1 'default width
Select Case lngCol
Case 0
'hide the first column
varRetVal = 0
Case 1
'return the default width for column 2
varRetVal = -1
End Select
Case acLBGetValue '6
'Return actual data
varRetVal = svarArray(lngRow, lngCol)
'If lngRow = 0 Then
'varRetVal = Null
' End If
Case acLBGetFormat '7
'return the formatting info for the row/column
Select Case lngCol
Case 0
Case 1
End Select
Case acLBEnd '9
'clean up
On Error Resume Next
Erase svarArray
Set rst = Nothing
Set cnn = Nothing
End Select
Proc_exit:
On Error Resume Next
valueList = varRetVal