为什么我的代码选择 &在我的 MshFlexgrid 中突出显示超过 1 行?
我有一个使用 SQL2008 数据库的 VB6 项目。该项目由两个组合框、一个 MSHFlexGrid 和两个命令按钮(cmdLoadSeries 和 cmdExit)组成。用户将从第一个组合框中进行选择,然后按 cmdLoadSeries 命令按钮,该按钮将填充第二个组合框和 MSHFlexgrid。我正在使用文本框来操作网格中的信息。
我第一次在 mshflexgrid 中选择一行时,它会选择/突出显示我单击的行及其上方的所有内容。第一次之后,它只选择/突出显示我单击的行。为什么?请帮忙。
这是我的代码:
Private Sub cmdLoadSeries_Click()
Const cProcName = msModuleName & "cmdLoadSeries"
'Too save space I removed the code that retrieves MRecordSet.
If mRecordSet.RecordCount > 0 Then
LoadControls
SetFormFields True
DataCombo1.BoundText = mRecordSet2.Fields(0)
Else
LoadControls
cmdExit.Enabled = True
End If
cmdLoadSeries.Enabled = False
Combo1.Enabled = False
End Sub
Private Sub LoadControls()
Const cProcName = msModuleName & "LoadControls"
With mRecordSet
OpenRSFlexGrid1
FillFlexGrid1
End With
End Sub
Sub OpenRSFlexGrid1
'This code setups a recordset used to populate the mshflexgrid with
End Sub
Sub FillFlexGrid1(Optional pbClear As Boolean)
Const cProcName = msModuleName & "FillFlexGrid1"
Dim llCntrRow As Integer
Dim llCntrCol As Integer
Dim max_len As Single
Dim new_len As Single
Dim liCntr As Integer
Dim llCol As Long
Text1.BorderStyle = 0
With MSFlexGrid1
MSFlexGrid1.Clear
Text1.FontName = .FontName
Text1.FontSize = .FontSize
Text1.Visible = False
.Cols = mRecordset4.Fields.Count
.FixedCols = 1
If mRecordset4.RecordCount > 0 And (Not pbClear = True) Then
.Rows = mRecordset4.RecordCount + 1
.FixedRows = 1
Else
.Rows = 2
.FixedRows = 1
End If
For llCntrCol = 0 To .Cols - 1
.TextMatrix(0, llCntrCol) = mRecordset4.Fields(llCntrCol).Name
Next
If mRecordset4.RecordCount > 0 And (Not pbClear = True) Then
mRecordset4.MoveFirst
For llCntrRow = 1 To mRecordset4.RecordCount
For llCntrCol = 0 To .Cols - 1
.TextMatrix(llCntrRow, llCntrCol) = Trim(CStr(mRecordset4.Fields(llCntrCol).Value))
Next
mRecordset4.MoveNext
Next
Else
For llCntrCol = 0 To .Cols - 1
.TextMatrix(.FixedRows, llCntrCol) = ""
Next
End If
Font.Name = MSFlexGrid1.Font.Name
Font.Size = MSFlexGrid1.Font.Size
For llCntrCol = 0 To MSFlexGrid1.Cols - 1
max_len = 0
If .TextMatrix(0, llCntrCol) = "setoutid" Then
MSFlexGrid1.ColWidth(llCntrCol) = TextWidth("W") * 0.54
Else
For llCntrRow = 0 To MSFlexGrid1.Rows - 1
new_len = TextWidth(MSFlexGrid1.TextMatrix(llCntrRow, llCntrCol))
If max_len < new_len Then max_len = new_len
Next llCntrRow
Dim lsFillColumn As String
lsFillColumn = String(42, "W")
If .TextMatrix(0, llCntrCol) = "setoutname" And TextWidth(lsFillColumn) > max_len Then
max_len = TextWidth(lsFillColumn)
End If
MSFlexGrid1.ColWidth(llCntrCol) = max_len + (TextWidth("W") * 1.5)
MSFlexGrid1.ColAlignment(llCntrCol) = flexAlignLeftCenter
End If
Next llCntrCol
.Col = .FixedCols
.Row = .FixedRows
End With
Exit Sub
errFillFlexGrid1:
Resume Next
End Sub
Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
Const cProcName = msModuleName & "MSFlexGrid1_KeyDown"
On Error GoTo errhandle
With MSFlexGrid1
If Text1.Visible = False Then
Select Case KeyCode
Case 45
If Shift = 1 Then
.AddItem "", .Row + 1
Else
.AddItem "", .Row
End If
mbFlexGrid1Changed = True
Case 46
If MSFlexGrid1.Rows = .FixedRows + 1 Then
MSFlexGrid1.Rows = MSFlexGrid1.Rows + .FixedRows - 1
Else
.RemoveItem .Row
End If
mbFlexGrid1Changed = True
End Select
End If
End With
Exit Sub
errhandle:
Resume Next
End Sub
Private Sub Text1_LostFocus()
Const cProcName = msModuleName & "Text1_LostFocus"
On Error GoTo errhandle
If Text1.Visible Then
MSFlexGrid1.Text = Text1.Text
End If
Text1.Visible = False
Exit Sub
errhandle:
Resume Next
End Sub
Private Sub MSFlexGrid1_GotFocus()
Const cProcName = msModuleName & "MSFlexGrid1_GotFocus"
On Error GoTo errhandle
bLostFocus = False
pSetTabStop (True)
If mlCurrentCol > 0 Then
MSFlexGrid1.Col = mlCurrentCol
MSFlexGrid1.Row = mlCurrentRow
End If
mlCurrentCol = 0
mlCurrentRow = 0
If Text1.Visible Then
MSFlexGrid1.Text = Text1.Text
Text1.Visible = False
End If
Exit Sub
errhandle:
Resume Next
End Sub
Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)
Const cProcName = msModuleName & "MSFlexGrid1_KeyPress"
On Error GoTo errhandle
Select Case KeyAscii
Case 27
If Text1.Visible Then
Text1.Visible = False
End If
Case Else
FlexGridEdit KeyAscii
End Select
Exit Sub
errhandle:
Resume Next
End Sub
Private Sub MSFlexGrid1_LeaveCell()
Const cProcName = msModuleName & "MSFlexGrid1_LeaveCell"
On Error GoTo errhandle
If Text1.Visible Then
MSFlexGrid1.Text = Text1.Text
Text1.Visible = False
End If
Exit Sub
errhandle:
Resume Next
End Sub
Private Function FlexGridChkPos(KeyCode As Integer) As Boolean
Dim llNextRow As Long
Dim llNextCol As Long
Dim llCurrCol As Long
Dim llCurrRow As Long
Dim llTotCols As Long
Dim llTotRows As Long
Dim llBegRow As Long
Dim llBegCol As Long
Dim llCntrCol As Long
Dim lsText As String
Const cProcName = msModuleName & "FlexGridChkPos"
On Error GoTo errhandle
With MSFlexGrid1
llCurrRow = .Row + 1
llCurrCol = .Col + 1
llTotRows = .Rows
llTotCols = .Cols
llBegRow = .FixedRows
llBegCol = .FixedCols
If KeyCode = vbKeyRight Or KeyCode = vbKeyReturn Then
llNextCol = llCurrCol + 1
If llNextCol > llTotCols Then
llNextRow = llCurrRow + 1
If llNextRow > llTotRows Then
GoSub LogLine
.Rows = .Rows + 1
llCurrRow = llCurrRow + 1
llCurrCol = 1 + llBegCol
Else
llCurrRow = llNextRow
llCurrCol = 1 + llBegCol
End If
Else
llCurrCol = llNextCol
End If
End If
If KeyCode = vbKeyLeft Then
llNextCol = llCurrCol - 1
If llNextCol = llBegCol Then
llNextRow = llCurrRow - 1
If llNextRow = llBegRow Then
llCurrRow = llTotRows
Else
llCurrRow = llNextRow
End If
llCurrCol = llTotCols
Else
llCurrCol = llNextCol
End If
End If
.Col = llCurrCol - 1
.Row = llCurrRow - 1
End With
Exit Function
LogLine:
lsText = ""
Return
errhandle:
Resume Next
End Function
I have a VB6 project that is using a SQL2008 database. The project consists of two Combo Boxes , a MSHFlexGrid, and Two Command Buttons(cmdLoadSeries & cmdExit). The user will make a selection from the first Combo box and press the cmdLoadSeries command button which populates the 2nd combo box and the MSHFlexgrid. I am using a text box to manipulate the info in the grid.
The First time I select a line in the mshflexgrid it selects/Highlights the row i clicked on and everything above it as well. After the first time, it only selects/highlights the row I clicked on. Why? Please help.
Here is my code:
Private Sub cmdLoadSeries_Click()
Const cProcName = msModuleName & "cmdLoadSeries"
'Too save space I removed the code that retrieves MRecordSet.
If mRecordSet.RecordCount > 0 Then
LoadControls
SetFormFields True
DataCombo1.BoundText = mRecordSet2.Fields(0)
Else
LoadControls
cmdExit.Enabled = True
End If
cmdLoadSeries.Enabled = False
Combo1.Enabled = False
End Sub
Private Sub LoadControls()
Const cProcName = msModuleName & "LoadControls"
With mRecordSet
OpenRSFlexGrid1
FillFlexGrid1
End With
End Sub
Sub OpenRSFlexGrid1
'This code setups a recordset used to populate the mshflexgrid with
End Sub
Sub FillFlexGrid1(Optional pbClear As Boolean)
Const cProcName = msModuleName & "FillFlexGrid1"
Dim llCntrRow As Integer
Dim llCntrCol As Integer
Dim max_len As Single
Dim new_len As Single
Dim liCntr As Integer
Dim llCol As Long
Text1.BorderStyle = 0
With MSFlexGrid1
MSFlexGrid1.Clear
Text1.FontName = .FontName
Text1.FontSize = .FontSize
Text1.Visible = False
.Cols = mRecordset4.Fields.Count
.FixedCols = 1
If mRecordset4.RecordCount > 0 And (Not pbClear = True) Then
.Rows = mRecordset4.RecordCount + 1
.FixedRows = 1
Else
.Rows = 2
.FixedRows = 1
End If
For llCntrCol = 0 To .Cols - 1
.TextMatrix(0, llCntrCol) = mRecordset4.Fields(llCntrCol).Name
Next
If mRecordset4.RecordCount > 0 And (Not pbClear = True) Then
mRecordset4.MoveFirst
For llCntrRow = 1 To mRecordset4.RecordCount
For llCntrCol = 0 To .Cols - 1
.TextMatrix(llCntrRow, llCntrCol) = Trim(CStr(mRecordset4.Fields(llCntrCol).Value))
Next
mRecordset4.MoveNext
Next
Else
For llCntrCol = 0 To .Cols - 1
.TextMatrix(.FixedRows, llCntrCol) = ""
Next
End If
Font.Name = MSFlexGrid1.Font.Name
Font.Size = MSFlexGrid1.Font.Size
For llCntrCol = 0 To MSFlexGrid1.Cols - 1
max_len = 0
If .TextMatrix(0, llCntrCol) = "setoutid" Then
MSFlexGrid1.ColWidth(llCntrCol) = TextWidth("W") * 0.54
Else
For llCntrRow = 0 To MSFlexGrid1.Rows - 1
new_len = TextWidth(MSFlexGrid1.TextMatrix(llCntrRow, llCntrCol))
If max_len < new_len Then max_len = new_len
Next llCntrRow
Dim lsFillColumn As String
lsFillColumn = String(42, "W")
If .TextMatrix(0, llCntrCol) = "setoutname" And TextWidth(lsFillColumn) > max_len Then
max_len = TextWidth(lsFillColumn)
End If
MSFlexGrid1.ColWidth(llCntrCol) = max_len + (TextWidth("W") * 1.5)
MSFlexGrid1.ColAlignment(llCntrCol) = flexAlignLeftCenter
End If
Next llCntrCol
.Col = .FixedCols
.Row = .FixedRows
End With
Exit Sub
errFillFlexGrid1:
Resume Next
End Sub
Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
Const cProcName = msModuleName & "MSFlexGrid1_KeyDown"
On Error GoTo errhandle
With MSFlexGrid1
If Text1.Visible = False Then
Select Case KeyCode
Case 45
If Shift = 1 Then
.AddItem "", .Row + 1
Else
.AddItem "", .Row
End If
mbFlexGrid1Changed = True
Case 46
If MSFlexGrid1.Rows = .FixedRows + 1 Then
MSFlexGrid1.Rows = MSFlexGrid1.Rows + .FixedRows - 1
Else
.RemoveItem .Row
End If
mbFlexGrid1Changed = True
End Select
End If
End With
Exit Sub
errhandle:
Resume Next
End Sub
Private Sub Text1_LostFocus()
Const cProcName = msModuleName & "Text1_LostFocus"
On Error GoTo errhandle
If Text1.Visible Then
MSFlexGrid1.Text = Text1.Text
End If
Text1.Visible = False
Exit Sub
errhandle:
Resume Next
End Sub
Private Sub MSFlexGrid1_GotFocus()
Const cProcName = msModuleName & "MSFlexGrid1_GotFocus"
On Error GoTo errhandle
bLostFocus = False
pSetTabStop (True)
If mlCurrentCol > 0 Then
MSFlexGrid1.Col = mlCurrentCol
MSFlexGrid1.Row = mlCurrentRow
End If
mlCurrentCol = 0
mlCurrentRow = 0
If Text1.Visible Then
MSFlexGrid1.Text = Text1.Text
Text1.Visible = False
End If
Exit Sub
errhandle:
Resume Next
End Sub
Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)
Const cProcName = msModuleName & "MSFlexGrid1_KeyPress"
On Error GoTo errhandle
Select Case KeyAscii
Case 27
If Text1.Visible Then
Text1.Visible = False
End If
Case Else
FlexGridEdit KeyAscii
End Select
Exit Sub
errhandle:
Resume Next
End Sub
Private Sub MSFlexGrid1_LeaveCell()
Const cProcName = msModuleName & "MSFlexGrid1_LeaveCell"
On Error GoTo errhandle
If Text1.Visible Then
MSFlexGrid1.Text = Text1.Text
Text1.Visible = False
End If
Exit Sub
errhandle:
Resume Next
End Sub
Private Function FlexGridChkPos(KeyCode As Integer) As Boolean
Dim llNextRow As Long
Dim llNextCol As Long
Dim llCurrCol As Long
Dim llCurrRow As Long
Dim llTotCols As Long
Dim llTotRows As Long
Dim llBegRow As Long
Dim llBegCol As Long
Dim llCntrCol As Long
Dim lsText As String
Const cProcName = msModuleName & "FlexGridChkPos"
On Error GoTo errhandle
With MSFlexGrid1
llCurrRow = .Row + 1
llCurrCol = .Col + 1
llTotRows = .Rows
llTotCols = .Cols
llBegRow = .FixedRows
llBegCol = .FixedCols
If KeyCode = vbKeyRight Or KeyCode = vbKeyReturn Then
llNextCol = llCurrCol + 1
If llNextCol > llTotCols Then
llNextRow = llCurrRow + 1
If llNextRow > llTotRows Then
GoSub LogLine
.Rows = .Rows + 1
llCurrRow = llCurrRow + 1
llCurrCol = 1 + llBegCol
Else
llCurrRow = llNextRow
llCurrCol = 1 + llBegCol
End If
Else
llCurrCol = llNextCol
End If
End If
If KeyCode = vbKeyLeft Then
llNextCol = llCurrCol - 1
If llNextCol = llBegCol Then
llNextRow = llCurrRow - 1
If llNextRow = llBegRow Then
llCurrRow = llTotRows
Else
llCurrRow = llNextRow
End If
llCurrCol = llTotCols
Else
llCurrCol = llNextCol
End If
End If
.Col = llCurrCol - 1
.Row = llCurrRow - 1
End With
Exit Function
LogLine:
lsText = ""
Return
errhandle:
Resume Next
End Function
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
首次进入网格时,.row 参数未正确设置。
The .row parameter was not being set correctly upon first entering the grid.