请教关于LISTVIEW的数据绑定问题.VB6
小弟只玩过.NET里面的.VB6还真不会,哪位大哥能不能给个例子看下,分数好说.
[解决办法]
listview不是靠绑定的。确切的说,listview并不是一个网格控件。
看下面的，至于怎么打开数据库之类不用说了吧。
Private Sub Form_Load()
Dim i As Integer
With Me.ListView1
.View = lvwReport
.ColumnHeaders.Add , , "a "
.ColumnHeaders.Add , , "b "
For i = 1 To 33
.ListItems.Add , , i
.ListItems(i).SubItems(1) = i + 1
Next
End With
End Sub
[解决办法]
你用 数据窗体 向导 生成一个 数据窗体，然后看看它用了什么控件
[解决办法]
'用了多年的Code,现公布出来共享 -- CHEERS!
'cADOListView 动态绑定数据
Option Explicit
' Private: Internal Error Declarations
Private Const csSOURCE_ERR As String = "cADOListView "
Private Const clLISTHOOK_ERR As Long = vbObjectError + 2048 + 303
Private Const csLISTHOOK_ERR As String = "Invalid control! Must be a VB6 ListView control "
' Private: Variables and Declarations
'
Private WithEvents oList As MSComctlLib.ListView
Private moCon As ADODB.Connection, _
msConnect As String
' Public Declarations
'
Public Enum eJetVersion
ejvJet3 = 3
ejvJet4 = 4
End Enum
'===========================================================================
' Public Properties
' Public Subroutines and Functions
'
Public Sub ConnectString(ByVal FileName As String, _
Optional ByVal User As String = "admin ", _
Optional ByVal Password As String = " ", _
Optional ByVal DefPath As String = " ", _
Optional ByVal JetVersion As eJetVersion = ejvJet3)
If Len(Trim$(DefPath)) = 0 Then DefPath = App.Path + "\ "
Select Case JetVersion
Case ejvJet3
msConnect = "Driver={Microsoft Access Driver (*.mdb)};DBQ= " + _
Trim$(FileName) + ";DefaultDir= " + Trim$(DefPath) + ";UID= " + _
Trim$(User) + ";PWD=; " + Trim$(Password)
Case ejvJet4
msConnect = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source= " & Trim$(FileName) & "; " & _
"Jet OLEDB:Database Password=; " & _
"Jet OLEDB:Engine Type=5; "
End Select
Set moCon = New ADODB.Connection
End Sub
Public Sub HookCtrl(ByRef Ctrl As Object)
If (Not TypeName(Ctrl) = "ListView ") And (Not TypeName(Ctrl) = "IListView ") Then
Err.Raise clLISTHOOK_ERR, csSOURCE_ERR, csLISTHOOK_ERR
Exit Sub
End If
Set oList = Ctrl '## Capture the Listview control.
' Class won 't work if this isn 't called first.
End With
End Sub
Public Sub Load(SQL As String)
Dim oRS As ADODB.Recordset, _
oCmd As ADODB.Command, _
oLstHdr As MSComctlLib.ColumnHeaders, _
oItems As MSComctlLib.ListItems, _
oItem As MSComctlLib.ListItem, _
oObj As Object, _
lLoop As Long, _
sMax() As String, _
sValue As String, _
lWidth As Long, _
lTWidth As Long, _
lOffset As Long
On Error GoTo ErrorHandler
Set moCon = New ADODB.Connection
Set oCmd = New ADODB.Command
Set oRS = New ADODB.Recordset
moCon.Open msConnect
With oRS
With oCmd
.CommandType = adCmdText
.CommandText = SQL
Set .ActiveConnection = moCon
End With
.CursorLocation = ADODB.adUseClient
.CacheSize = 1
'
'## Execute SQL command
'
.Open oCmd, , ADODB.adOpenForwardOnly
'
'## Hook the parent form to do textmetrics
'
Set oObj = oList.Parent
Set oObj.Font = oList.Font
'
'## Reset the ListView Header & Data
'
oList.ListItems.Clear
Set oLstHdr = oList.ColumnHeaders
oLstHdr.Clear
'
'## Add Headers and set the appropriate width for each column
'
ReDim sMax(0 To .Fields.Count - 1) As String
For lLoop = 0 To .Fields.Count - 1
With .Fields(lLoop)
lWidth = oObj.TextWidth(.Name) + 180
oLstHdr.Add , .Name, .Name, lWidth
#If DEBUGMODE = 1 Then
Debug.Print .Name, .Type, .Attributes, .DefinedSize, .NumericScale, .Precision, .Status
#End If
End With
Next
'
'## Now, if there 's any data, add it to the ListView
'
If .RecordCount Then
Set oItems = oList.ListItems
Do
For lLoop = 0 To .Fields.Count - 1
sValue = CStr(oRS(lLoop).Value)
If Len(sMax(lLoop)) < Len(sValue) Then sMax(lLoop) = sValue
Select Case lLoop
Case Is > 0
oItem.ListSubItems.Add , CStr(lLoop) + oItem.Key + sValue, sValue
Case Else
Set oItem = oItems.Add(, "K " + CStr(.AbsolutePosition), sValue)
End Select
Next
.MoveNext
Loop Until .EOF
'
'## Set column "best fit " width now that the data is loaded.
'
lOffset = 360 '## 2 x 180 - required for first column if has icon
For lLoop = 0 To .Fields.Count - 1
'lOffset = 180 * 2 ^ Abs(lLoop = 0) ' < < IIf(lLoop = 0, 360, 180)
With oLstHdr(lLoop + 1)
lTWidth = oObj.TextWidth(sMax(lLoop)) + lOffset
If lTWidth > .Width Then
.Width = lTWidth
End If
Select Case oRS.Fields(lLoop).Type
Case adVarWChar, adLongVarWChar: If .Width > 3000 Then .Width = 3000
Case Is > adLongVarWChar: If .Width > 1000 Then .Width = 1000
End Select
End With
lOffset = 180 '## set to standard adj
Next
End If
End With
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 94 '!! Invalid use of Null - occurs during adding of RS data to ListView control
sValue = "[Null] "
Resume Next
Case 6
sValue = "[Binary] "
Resume Next
Case Else
oList.Visible = True
MsgBox "ERROR::Description ' " + Err.Description + " ' ", _
vbInformation + vbOKOnly + vbApplicationModal, _
"cADOListView "
End Select
End Sub
' Internal Class Subroutines
'
Private Sub Class_Initialize()
'
End Sub
Private Sub Class_Terminate()
Set oList = Nothing
End Sub
