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

ken16 2003-02-12 10:57:24
在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
...全文
63 3 打赏 收藏 举报
写回复
3 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
ericlau 2003-02-14
用如下代码实现和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
  • 打赏
  • 举报
回复
ken16 2003-02-13
up
  • 打赏
  • 举报
回复
ken16 2003-02-12
同事我还有一个疑问,就是为什么datagrid为什么没有实现这个功能?这个功能很常见啊,难道这里有什么问题?
  • 打赏
  • 举报
回复
发帖
控件
加入

1433

社区成员

VB 控件
社区管理员
  • 控件
申请成为版主
帖子事件
创建了帖子
2003-02-12 10:57
社区公告
暂无公告