在datagrid上实现shift+click选中一个范围内的记录行（附一个解决方法源代码）

[ken16]

在execl中，按shift＋click可以选中一个范围内的连续的记录行。
在datagrid中，我没有发现有类似的功能，因此我自己尝试做了一下。

下面是源代码，但没有完全解决这个问题。

具体来说，就是无法在按下ctrl+click时改变dbgrid的当前记录行。

比如，有如下记录
record1
record2
record3
record4
record5
record6

有如下操作顺序，
(1)click record1 --> 共选中了record1
(2)ctrl+click record3 --> 共选中了record1和record3
(3)shift+click record 5 --> 共选中了record1至record5的5条记录

我希望在第(3)步选中的是 record1, record3至record5
在此请教各位，看看有什么方法解决。


数据库结构：
这个例子是从DBGTUTOR中的TUTOR6改进而来，在Composer表中增加列（ComposerID 自动编号），并置ComposerID为第一列。
把Data1中的sql改为 select * from composer

Option Explicit

Private Const VK_SHIFT = &H10
'这个方法有一个限制条件，就是记录要有主键。我的例子中是一个integer
Private ciStartRuleID As Integer
'一个标志，表明当前shift是否被按下
Private cbIsShiftDown As Boolean

Private Sub DBGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If VK_SHIFT = KeyCode Then
If False = cbIsShiftDown Then
'刚按下shift时，获得当前记录行的key
ciStartRuleID = DBGrid1.Columns(0)
End If
cbIsShiftDown = True
End If
End Sub

Private Sub DBGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
If VK_SHIFT = KeyCode Then
cbIsShiftDown = False
End If
End Sub

Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If True = cbIsShiftDown Then

Dim liEndRuleID As Integer
liEndRuleID = DBGrid1.Columns(0)

Dim dclone As Recordset
Set dclone = Data1.Recordset.Clone()

Dim SelBks As SelBookmarks
Set SelBks = DBGrid1.SelBookmarks

dclone.MoveFirst
While Not dclone.EOF
If dclone.Fields(0) = ciStartRuleID Then
GoTo MatchStart
End If
If dclone.Fields(0) = liEndRuleID Then
liEndRuleID = ciStartRuleID
GoTo MatchStart
End If

dclone.MoveNext
Wend

MatchStart:
While Not dclone.EOF
SelBks.Add dclone.Bookmark
If dclone.Fields(0) = liEndRuleID Then
GoTo MatchEnd
End If
dclone.MoveNext
Wend
End If

MatchEnd:

End Sub

Private Sub DBGrid1_SelChange(Cancel As Integer)
If True = cbIsShiftDown Then
'保持按下shift之前被选中的记录
Cancel = True
End If
End Sub

Private Sub Form_Load()
cbIsShiftDown = False
End Sub

[ken16]

同事我还有一个疑问，就是为什么datagrid为什么没有实现这个功能？这个功能很常见啊，难道这里有什么问题？

[ken16]

up

[ericlau]

用如下代码实现和execl同样的功能。

Option Explicit
Private cbIsShiftDown As Boolean
Private cbIsCtrlDown As Boolean
Private ciBaseIndex As Integer
Private caBeforeShiftDownSelection() As Integer
Private ciBeforeShiftDownSelectionCount As Integer

Private Sub ogd_KeyDown(KeyCode As Integer, Shift As Integer)
If vbKeyShift = KeyCode Then
If Not cbIsShiftDown Then
cbIsShiftDown = True
ciBaseIndex = ogd.Bookmark
Dim liCnt As Integer
Dim i As Integer
liCnt = ogd.SelBookmarks.Count - 1
If liCnt >= 0 Then
ReDim caBeforeShiftDownSelection(0 To liCnt)
For i = 0 To liCnt
caBeforeShiftDownSelection(i) = ogd.SelBookmarks(i)
Next i
ciBeforeShiftDownSelectionCount = liCnt
End If
End If
End If
If vbKeyControl = KeyCode Then
'CtrlDown's priority higher than ShiftDown
cbIsCtrlDown = True
cbIsShiftDown = False
End If
End Sub

Private Sub ogd_KeyUp(KeyCode As Integer, Shift As Integer)
If vbKeyShift = KeyCode Then
cbIsShiftDown = False
End If
If vbKeyControl = KeyCode Then
cbIsCtrlDown = False
End If
End Sub

Private Sub ogd_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If Not IsNull(ogd.Bookmark) Then
ogd.SelBookmarks.Add ogd.Bookmark
ogd.Col = 5
End If
End Sub

Private Sub ogd_SelChange(Cancel As Integer)
Dim i As Integer

If cbIsShiftDown Then
'add the select range into selbookmarks
Dim liSelCnt As Integer
Dim liCurrIndex As Integer
liCurrIndex = ogd.Bookmark

If liCurrIndex > ciBaseIndex Then
liSelCnt = liCurrIndex - ciBaseIndex
For i = 0 To liSelCnt
ogd.SelBookmarks.Add ogd.GetBookmark(-i)
Next i
Else
liSelCnt = ciBaseIndex - liCurrIndex
For i = 0 To liSelCnt
ogd.SelBookmarks.Add ogd.GetBookmark(i)
Next i
End If

'restore the selections which are selected before shift down
For i = 0 To ciBeforeShiftDownSelectionCount
ogd.SelBookmarks.Add ogd.GetBookmark(caBeforeShiftDownSelection(i) - liCurrIndex)
Next i
Else
If cbIsCtrlDown Then
'change current record,change the default action of datagrid when ctrl is down
Dim liCnt As Integer
liCnt = ogd.SelBookmarks.Count - 1
If liCnt >= 0 Then
ogd.Bookmark = ogd.SelBookmarks(liCnt)
End If
End If
End If
End Sub

Private Sub Form_Load()
cbIsShiftDown = False
cbIsCtrlDown = False
ciBaseIndex = -1
ciBeforeShiftDownSelectionCount = -1
ogd.Columns(5).Visible = False
ogd.Col = 5
End Sub