为什么我的代码选择 &在我的 MshFlexgrid 中突出显示超过 1 行?

发布于 2024-10-06 14:24:40 字数 7091 浏览 5 评论 0原文

我有一个使用 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 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

离笑几人歌 2024-10-13 14:24:40

首次进入网格时,.row 参数未正确设置。

The .row parameter was not being set correctly upon first entering the grid.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文