|
-
Nov 14th, 2021, 10:13 AM
#17
Re: ucGridPlus
Hi Leandro,
This is a very nice project, thank you for releasing it to the community.
I had a need for some features that aren't provided by the grid at the moment. I was able to implement them myself, but I thought I would pass them on to you in case you want to include them.
First, I needed a BeforeEdit event:
Code:
Public Event BeforeEdit(ByVal lRow As Long, ByVal lCol As Long, ByVal vValue As Variant, ByRef bCancel As Boolean)
The Cancel parameter allows the host to prevent editing of a cell that would otherwise be allowed by the "Row/ColEdition" properties.
In some case you want to disallow cell editing based on dynamic criteria, and the BeforeEdit event makes this possible.
Second, I wanted to allow vbSpace to toggle checkbox cells to match user's expectations with other checkbox controls.
Lastly, I wanted to allow the F2 key to start editing cells, again to match user's expectations with other controls.
I edited the code as follows:
The UserControl_KeyPress event now looks like this:
Code:
Private Sub UserControl_KeyPress(KeyAscii As Integer)
' Pass KeyAscii=0 to start edit a cell (where allowed) without raising keypress events
Dim bCancel As Boolean
If KeyAscii <> 0 Then RaiseEvent KeyPress(KeyAscii)
If Not IsPointEmpty(SelCel) Then
If mCol(SelCel.X).DataType = GP_BOOLEAN Then 'if is Boolean click
Select Case KeyAscii
Case vbKeySpace, vbKeyReturn
RaiseEvent BeforeEdit(SelCel.Y, SelCel.X, mRow(SelCel.Y).Cells(SelCel.X).Value, bCancel)
If Not bCancel Then
mRow(SelCel.Y).Cells(SelCel.X).Value = Not mRow(SelCel.Y).Cells(SelCel.X).Value
Draw
RaiseEvent AfterEdit(SelCel.Y, SelCel.X, Not mRow(SelCel.Y).Cells(SelCel.X).Value)
End If
End Select
Exit Sub
Else
If KeyAscii = vbKeyReturn Then Exit Sub 'Filter Key Enter
If KeyAscii = vbKeyBack Then KeyAscii = 0
End If
If mRow(PtrRow(SelCel.Y)).IsGroup = True Then Exit Sub
If mRow(PtrRow(SelCel.Y)).IsFullRow = True Then Exit Sub
If mCol(PtrCol(SelCel.X)).EditionLocked = False Then
If mRow(PtrRow(SelCel.Y)).Cells(PtrCol(SelCel.X)).EditionLocked = False Then
CellStartEdit SelCel.Y, SelCel.X
If KeyAscii <> 0 Then
Text1.Text = Chr(KeyAscii)
Text1.SelStart = Len(Text1.Text)
End If
End If
End If
End If
End Sub
The UserControl_MouseUp event now looks like this:
Code:
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim R As Rect, R2 As Rect, vOldValue As Variant
Dim bCheckRow As Boolean, bText As Boolean, bImage As Boolean
Dim i As Long
Dim mTemp As Long
Dim HotCell As POINTAPI
Dim Cel As POINTAPI
Dim bCancel As Boolean
SizeColumn.CurColumn = -1
SizeColumn.CurRow = -1
Timer1.Interval = 0
If mColDrag.X > -1 Then
mColDrag.X = -1
If mColDrag.DestCol > -1 Then
mTemp = PtrCol(mColDrag.SrcCol)
If mColDrag.DestCol < mColDrag.SrcCol Then
For i = mColDrag.SrcCol To mColDrag.DestCol + 1 Step -1
PtrCol(i) = PtrCol(i - 1)
Next
Else
For i = mColDrag.SrcCol To mColDrag.DestCol - 1
PtrCol(i) = PtrCol(i + 1)
Next
End If
PtrCol(mColDrag.DestCol) = mTemp
If m_SelectionMode <> GP_SelByMultiRow And m_SelectionMode <> GP_SelBySingleRow Then
SelCel.X = mColDrag.DestCol
SelRange.Start.X = mColDrag.DestCol
SelRange.End.X = mColDrag.DestCol
End If
Draw
RaiseEvent AfterColumnDrag(mColDrag.DestCol)
GoTo EventMouseUp
End If
End If
'Cell checkbox
If PvGetHotCell(X, Y, HotCell, R) Then
IsMouseInCellPart HotCell.Y, HotCell.X, X, Y, bCheckRow, bText, bImage
If bCheckRow Then
SetCursor hCurHands
mRow(PtrRow(HotCell.Y)).Checked = Not mRow(PtrRow(HotCell.Y)).Checked
m_AllRowAreCheked = True
For i = 0 To m_RowsCount - 1
If mRow(PtrRow(i)).Checked = False Then
m_AllRowAreCheked = False
Exit For
End If
Next
Draw
GoTo EventMouseUp
End If
If (bText And mCol(PtrCol(HotCell.X)).LabelsEvents) Or (bText And mCol(PtrCol(HotCell.X)).DataType = GP_BOOLEAN) Then
If mCol(PtrCol(HotCell.X)).DataType = GP_BOOLEAN And Not mCol(PtrCol(HotCell.X)).EditionLocked And m_AllowEdit Then
RaiseEvent BeforeEdit(HotCell.Y, HotCell.X, mRow(PtrRow(HotCell.Y)).Cells(PtrCol(HotCell.X)).Value, bCancel)
If bCancel Then GoTo EventMouseUp
If mRow(PtrRow(HotCell.Y)).Cells(PtrCol(HotCell.X)).EditionLocked = False Then
SetCursor hCurHands
With mRow(PtrRow(HotCell.Y)).Cells(PtrCol(HotCell.X))
vOldValue = .Value
If IsNull(.Value) Then
.Value = True
Else
.Value = Not .Value
End If
End With
Draw
RaiseEvent AfterEdit(HotCell.Y, HotCell.X, vOldValue)
End If
Else
SetCursor hCurHands
RaiseEvent LabelMouseUp(HotCell.Y, HotCell.X, Button, Shift)
End If
End If
If bImage And mCol(PtrCol(HotCell.X)).ImagesEvents Then
SetCursor hCurHands
RaiseEvent ImgMouseUp(HotCell.Y, HotCell.X, Button, Shift)
End If
End If
If Y < m_HeaderHeight And m_HeaderHeight > 0 Then
If IsHotColCheckBox(HotCol, X, Y) Then
m_AllRowAreCheked = Not m_AllRowAreCheked
For i = 0 To m_RowsCount - 1
mRow(PtrRow(i)).Checked = m_AllRowAreCheked
Next
Draw
GoTo EventMouseUp
End If
'// Sort requested from Column Header click
If (HotCol <> C_NULL_RESULT) And (SizeColumn.HotColumn = C_NULL_RESULT) And Button = vbLeftButton Then
If m_AllowColumnSort Then
If (Shift And vbCtrlMask) And Not (mSortColumn = -1) Then
' If Not (mSortSubColumn = PtrCol(HotCol)) Then
' mCol(PtrCol(HotCol)).nSortOrder = lgSTNormal
' End If
'mSortSubColumn = HotCol
Sort mSortColumn, mCol(mSortColumn).nSortOrder, PtrCol(HotCol) ', mCol(PtrCol(mSortColumn)).nSortOrder
Else
If Not (mSortColumn = PtrCol(HotCol)) Then
mCol(PtrCol(HotCol)).nSortOrder = lgSTNormal
mSortSubColumn = -1
End If
'mSortColumn = HotCol
If Not (mSortSubColumn = -1) Then
Sort , , , mCol(PtrCol(mSortSubColumn)).nSortOrder
Else
Sort PtrCol(HotCol)
End If
End If
Draw
End If
End If
If HotCol <> -1 Then
RaiseEvent ColumnClick(HotCol, Button, Shift)
End If
End If
'Click in Group Button
If PvGetHotCell(X, Y, Cel, R) And eSelBy = SelectByCells Then
RaiseEvent CellClick(Cel.Y, Cel.X, Button, Shift)
End If
If PvGetHotCell(m_RowSelectorWidth + 1, Y, Cel, R) Then
If Button = vbLeftButton Then
If mRow(PtrRow(Cel.Y)).IsGroup = True Then
With R2
.Left = Margin + (20 * DpiF * mRow(PtrRow(Cel.Y)).Ident)
.Top = (R.Bottom - R.Top) / 2 - 8 * DpiF
.Right = .Left + 16 * DpiF
.Bottom = .Top + 16 * DpiF
End With
If PtInRect(R2, X - R.Left, Y - R.Top) Then
If mRow(PtrRow(Cel.Y)).IsGroupExpanded Then
GroupColapse Cel.Y
Else
GroupExpand Cel.Y
End If
End If
End If
End If
End If
EventMouseUp:
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
I added the following to the UserControl_KeyDown code:
Code:
Case vbKeyF2
UserControl_KeyPress 0 ' Send KeyAscii 0 to start cell editing when it is allowed
That code is in the Select Case KeyCode block, right before testing for "Case vbKeyRight".
Thanks again, and feel free to ignore this post if you aren't interested in making the suggested changes.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|