Option Explicit
Const DB_PATH = "E:\Program Files\Microsoft Visual Studio\vb98\nwind.mdb"Dim WithEvents SupplierFormat As StdDataFormat
Dim WithEvents CategoryFormat As StdDataFormatDim newValue As VariantPrivate Sub Form_Load()
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & DB_PATH
Adodc1.Refresh
' prepare the grid to host the combobox controls.
DataGrid1.RowHeight = cboSuppliers.Height
' load the two combobox controls with the lookup data.
Dim rs As New ADODB.Recordset
' The Suppliers table.
rs.Open "Suppliers", Adodc1.Recordset.ActiveConnection, adOpenStatic, adLockReadOnly, adCmdTable
Do Until rs.EOF
cboSuppliers.AddItem rs("CompanyName")
cboSuppliers.ItemData(cboSuppliers.NewIndex) = rs("SupplierID")
rs.MoveNext
Loop
rs.Close
' The Categories table.
rs.Open "Categories", Adodc1.Recordset.ActiveConnection, adOpenStatic, adLockReadOnly, adCmdTable
Do Until rs.EOF
cboCategories.AddItem rs("CategoryName")
cboCategories.ItemData(cboCategories.NewIndex) = rs("CategoryID")
rs.MoveNext
Loop
rs.Close
' Prepare two StdDataFormat objects
Set SupplierFormat = New StdDataFormat
Set DataGrid1.Columns("Supplier").DataFormat = SupplierFormat
Set CategoryFormat = New StdDataFormat
Set DataGrid1.Columns("Category").DataFormat = CategoryFormat
' Put the grid in front of the two combobox controls.
DataGrid1.ZOrder
End SubPrivate Sub Form_Resize()
lblStatus.Width = ScaleWidth - lblStatus.Left
DataGrid1.Move 0, DataGrid1.Top, ScaleWidth, ScaleHeight - DataGrid1.Top
End SubPrivate Sub SupplierFormat_Format(ByVal DataValue As StdFormat.StdDataValue)
' Convert a SupplierID into a Supplier name.
Dim i As Long
For i = 0 To cboSuppliers.ListCount - 1
If cboSuppliers.ItemData(i) = DataValue Then
DataValue = cboSuppliers.List(i)
Exit For
End If
Next
End SubPrivate Sub CategoryFormat_Format(ByVal DataValue As StdFormat.StdDataValue)
' Convert a CategoryID into a category name.
Dim i As Long
For i = 0 To cboCategories.ListCount - 1
If cboCategories.ItemData(i) = DataValue Then
DataValue = cboCategories.List(i)
Exit For
End If
Next
End SubPrivate Sub cboSuppliers_Click()
' Change the value of the underlying grid cell.
DataGrid1.Columns("Supplier").value = cboSuppliers.ItemData(cboSuppliers.ListIndex)
End SubPrivate Sub cboCategories_Click()
' Change the value of the underlying grid cell.
DataGrid1.Columns("Category").value = cboCategories.ItemData(cboCategories.ListIndex)
End SubPrivate Sub MoveCombos()
' In case of error put the combobox outof sight.
On Error GoTo Error_Handler
' Start by hiding both comboboxes
If DataGrid1.Visible Then
DataGrid1.ZOrder
DataGrid1.SetFocus
End If
' Get a reference to the current column.
Dim gridCol As MSDataGridLib.Column
Set gridCol = DataGrid1.Columns(DataGrid1.col)
If Not DataGrid1.CurrentCellVisible Then
' do nothing if current cell isn't visible
ElseIf gridCol.Caption = "Supplier" Then
' Move the combobox inside the SupplierID column
cboSuppliers.Move DataGrid1.Left + gridCol.Left, DataGrid1.Top + DataGrid1.RowTop(DataGrid1.row), gridCol.Width
cboSuppliers.ZOrder
cboSuppliers.SetFocus
cboSuppliers.Text = gridCol.Text
Exit Sub
ElseIf gridCol.Caption = "Category" Then
' Move the combobox inside the SupplierID column
cboCategories.Move DataGrid1.Left + gridCol.Left, DataGrid1.Top + DataGrid1.RowTop(DataGrid1.row), gridCol.Width
cboCategories.ZOrder
cboCategories.SetFocus
cboCategories.Text = gridCol.Text
Exit Sub
End If
Error_Handler:End SubPrivate Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
MoveCombos
End SubPrivate Sub DataGrid1_RowResize(Cancel As Integer)
MoveCombos
End SubPrivate Sub DataGrid1_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
MoveCombos
End SubPrivate Sub DataGrid1_Scroll(Cancel As Integer)
MoveCombos
End SubPrivate Sub DataGrid1_SplitChange()
MoveCombos
End SubPrivate Sub DataGrid1_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
' ensure that no duplicate product name is entered
If DataGrid1.Columns(DataGrid1.col).DataField = "ProductName" Then
Dim rs As ADODB.Recordset
' Get a clone recordset
Set rs = Adodc1.Recordset.Clone(adLockReadOnly)
rs.MoveFirst
' see if this value is already in the recordset.
' (NewValue is set in Change event)
rs.Find "ProductName='" & newValue & "'"
If Not rs.EOF Then
MsgBox "This product is already in the list", vbCritical
Cancel = True
End If
End If
End SubPrivate Sub DataGrid1_Change()
' remember the last value edited (will be used in BeforeColUpdate)
newValue = DataGrid1.Text
End SubPrivate Sub cmdSplit_Click()
' create two splits, one with only the Product Name column
' and one with all the others
Dim i As Integer, gridCol As MSDataGridLib.Column
' Create a new split to the left of the existing split
With DataGrid1.Splits.Add(0)
' make its width the same as the ProductName column
.SizeMode = dbgExact
.Size = .Columns("ProductName").Width
' make all columns invisible but ProductName.
For Each gridCol In .Columns
gridCol.Visible = (gridCol.Caption = "ProductName")
Next
' Hide the vertical scrollbar
.ScrollBars = dbgHorizontal
End With
With DataGrid1.Splits(1)
' Delete the Productname column in the rightmost split by making it invisible.
.Columns("ProductName").Visible = False
' Hide Record selectors
.RecordSelectors = False
End With
' disable this button, so that no more splits can be created.
cmdSplit.Enabled = False
End Sub
Const DB_PATH = "E:\Program Files\Microsoft Visual Studio\vb98\nwind.mdb"Dim WithEvents SupplierFormat As StdDataFormat
Dim WithEvents CategoryFormat As StdDataFormatDim newValue As VariantPrivate Sub Form_Load()
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & DB_PATH
Adodc1.Refresh
' prepare the grid to host the combobox controls.
DataGrid1.RowHeight = cboSuppliers.Height
' load the two combobox controls with the lookup data.
Dim rs As New ADODB.Recordset
' The Suppliers table.
rs.Open "Suppliers", Adodc1.Recordset.ActiveConnection, adOpenStatic, adLockReadOnly, adCmdTable
Do Until rs.EOF
cboSuppliers.AddItem rs("CompanyName")
cboSuppliers.ItemData(cboSuppliers.NewIndex) = rs("SupplierID")
rs.MoveNext
Loop
rs.Close
' The Categories table.
rs.Open "Categories", Adodc1.Recordset.ActiveConnection, adOpenStatic, adLockReadOnly, adCmdTable
Do Until rs.EOF
cboCategories.AddItem rs("CategoryName")
cboCategories.ItemData(cboCategories.NewIndex) = rs("CategoryID")
rs.MoveNext
Loop
rs.Close
' Prepare two StdDataFormat objects
Set SupplierFormat = New StdDataFormat
Set DataGrid1.Columns("Supplier").DataFormat = SupplierFormat
Set CategoryFormat = New StdDataFormat
Set DataGrid1.Columns("Category").DataFormat = CategoryFormat
' Put the grid in front of the two combobox controls.
DataGrid1.ZOrder
End SubPrivate Sub Form_Resize()
lblStatus.Width = ScaleWidth - lblStatus.Left
DataGrid1.Move 0, DataGrid1.Top, ScaleWidth, ScaleHeight - DataGrid1.Top
End SubPrivate Sub SupplierFormat_Format(ByVal DataValue As StdFormat.StdDataValue)
' Convert a SupplierID into a Supplier name.
Dim i As Long
For i = 0 To cboSuppliers.ListCount - 1
If cboSuppliers.ItemData(i) = DataValue Then
DataValue = cboSuppliers.List(i)
Exit For
End If
Next
End SubPrivate Sub CategoryFormat_Format(ByVal DataValue As StdFormat.StdDataValue)
' Convert a CategoryID into a category name.
Dim i As Long
For i = 0 To cboCategories.ListCount - 1
If cboCategories.ItemData(i) = DataValue Then
DataValue = cboCategories.List(i)
Exit For
End If
Next
End SubPrivate Sub cboSuppliers_Click()
' Change the value of the underlying grid cell.
DataGrid1.Columns("Supplier").value = cboSuppliers.ItemData(cboSuppliers.ListIndex)
End SubPrivate Sub cboCategories_Click()
' Change the value of the underlying grid cell.
DataGrid1.Columns("Category").value = cboCategories.ItemData(cboCategories.ListIndex)
End SubPrivate Sub MoveCombos()
' In case of error put the combobox outof sight.
On Error GoTo Error_Handler
' Start by hiding both comboboxes
If DataGrid1.Visible Then
DataGrid1.ZOrder
DataGrid1.SetFocus
End If
' Get a reference to the current column.
Dim gridCol As MSDataGridLib.Column
Set gridCol = DataGrid1.Columns(DataGrid1.col)
If Not DataGrid1.CurrentCellVisible Then
' do nothing if current cell isn't visible
ElseIf gridCol.Caption = "Supplier" Then
' Move the combobox inside the SupplierID column
cboSuppliers.Move DataGrid1.Left + gridCol.Left, DataGrid1.Top + DataGrid1.RowTop(DataGrid1.row), gridCol.Width
cboSuppliers.ZOrder
cboSuppliers.SetFocus
cboSuppliers.Text = gridCol.Text
Exit Sub
ElseIf gridCol.Caption = "Category" Then
' Move the combobox inside the SupplierID column
cboCategories.Move DataGrid1.Left + gridCol.Left, DataGrid1.Top + DataGrid1.RowTop(DataGrid1.row), gridCol.Width
cboCategories.ZOrder
cboCategories.SetFocus
cboCategories.Text = gridCol.Text
Exit Sub
End If
Error_Handler:End SubPrivate Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
MoveCombos
End SubPrivate Sub DataGrid1_RowResize(Cancel As Integer)
MoveCombos
End SubPrivate Sub DataGrid1_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
MoveCombos
End SubPrivate Sub DataGrid1_Scroll(Cancel As Integer)
MoveCombos
End SubPrivate Sub DataGrid1_SplitChange()
MoveCombos
End SubPrivate Sub DataGrid1_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
' ensure that no duplicate product name is entered
If DataGrid1.Columns(DataGrid1.col).DataField = "ProductName" Then
Dim rs As ADODB.Recordset
' Get a clone recordset
Set rs = Adodc1.Recordset.Clone(adLockReadOnly)
rs.MoveFirst
' see if this value is already in the recordset.
' (NewValue is set in Change event)
rs.Find "ProductName='" & newValue & "'"
If Not rs.EOF Then
MsgBox "This product is already in the list", vbCritical
Cancel = True
End If
End If
End SubPrivate Sub DataGrid1_Change()
' remember the last value edited (will be used in BeforeColUpdate)
newValue = DataGrid1.Text
End SubPrivate Sub cmdSplit_Click()
' create two splits, one with only the Product Name column
' and one with all the others
Dim i As Integer, gridCol As MSDataGridLib.Column
' Create a new split to the left of the existing split
With DataGrid1.Splits.Add(0)
' make its width the same as the ProductName column
.SizeMode = dbgExact
.Size = .Columns("ProductName").Width
' make all columns invisible but ProductName.
For Each gridCol In .Columns
gridCol.Visible = (gridCol.Caption = "ProductName")
Next
' Hide the vertical scrollbar
.ScrollBars = dbgHorizontal
End With
With DataGrid1.Splits(1)
' Delete the Productname column in the rightmost split by making it invisible.
.Columns("ProductName").Visible = False
' Hide Record selectors
.RecordSelectors = False
End With
' disable this button, so that no more splits can be created.
cmdSplit.Enabled = False
End Sub
' Refuse to delete a product if there is one OrderDetail record
' that points to it
Dim rs As ADODB.Recordset, rsorderdetail As ADODB.Recordset, sql As String
' Retrieve all the records in OrderDetails that reference this product.
Set rs = Adodc1.Recordset
sql = "Select * FROM [Order Details] WHERE [Order Details].ProductID = " & rs("ProductID")
Set rsorderdetail = rs.ActiveConnection.Execute(sql)
' if this recordset contains any record, refuse to delete.
If Not rsorderdetail.EOF Then Cancel = True
End SubPrivate Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)
' Display a custom error message
MsgBox "Error code: " & DataError & vbCr & vbCr & DataGrid1.ErrorText, vbCritical
Response = 0
End SubPrivate Sub DataGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' Display a tooltip with the contents of the current cell
Dim row As Long, col As Long, value As Variant
On Error Resume Next
' Get the coordinates of the cell under the mouse cursor.
row = DataGrid1.RowContaining(Y)
col = DataGrid1.ColContaining(X)
If row >= 0 And col >= 0 Then
' Set the tooltip text if within the grid boundaries.
DataGrid1.ToolTipText = DataGrid1.Columns(col).CellValue(DataGrid1.RowBook(row))
Else
' Otherwise, clear the tooltip.
DataGrid1.ToolTipText = ""
End If
End SubPrivate Sub DataGrid1_SelChange(Cancel As Integer)
Dim rs As ADODB.Recordset, b As Variant
Dim count As Long, unitsInStock As Long, unitsOnOrder As Long
Set rs = Adodc1.Recordset.Clone(adLockReadOnly)
count = DataGrid1.SelBooks.count
If count = 0 Then
lblStatus = "No records selected"
Else
For Each b In DataGrid1.SelBooks
rs.Book = b
unitsInStock = unitsInStock + rs("unitsInStock")
unitsOnOrder = unitsOnOrder + rs("unitsOnOrder")
Next
lblStatus = count & " product(s) selected UnitsInStock =" & unitsInStock & " UnitsOnOrder =" & unitsOnOrder
End If
End SubPrivate Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
' You can't sort on lookup fields.
Select Case DataGrid1.Columns(ColIndex).Caption
Case "Supplier", "Category"
MsgBox "Sorry, can't sort on this field", vbExclamation
Exit Sub
End Select ' Sort on the clicked column
Dim rs As ADODB.Recordset
Set rs = Adodc1.Recordset
If rs.Sort <> DataGrid1.Columns(ColIndex).DataField & " ASC" Then
' Sort in ascending order - this block is executed if the
' grid isn't sorted, is sorted on a different field
' or is sorted in descending order
rs.Sort = DataGrid1.Columns(ColIndex).DataField & " ASC"
Else
' Sort in descending order
rs.Sort = DataGrid1.Columns(ColIndex).DataField & " DESC"
End If
' no need refresh the contents of the Datagrid
End Sub
自己找了