Почему мой код выбора и подсветки более 1 строки в моей MshFlexgrid? - PullRequest
0 голосов
/ 06 декабря 2010

У меня есть проект VB6, который использует базу данных SQL2008.Проект состоит из двух полей со списком, 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

1 Ответ

0 голосов
/ 13 января 2011

Параметр .row не был установлен правильно при первом входе в сетку.

...