Track Control -Double Click On Block

Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic

' Add the cExtender.cls to the Project then create a reference using WithEvents in the General Declarations area of the Form with the TrackControl
Dim WithEvents cExtender As cExtender

' Add the following code to the Form Load event
Set cExtender = New cExtender 
Call cExtender.Extend(TrackControl)   ' <<< TrackControl is the name of your TrackControl

' Add the following code to the Form Unload event
Call cExtender.ExtendComplete(TrackControl)   ' <<< TrackControl is the name of your TrackControl

' You now have a DblClick event for the Block, Column & Row for Left, Middle & Right Mouse Buttons
Private Sub cExtender_BlockDblClick(Button As Integer, ByVal Block As XtremeReportControl.TrackBlock)
    Debug.Print "BlockDblClick"
End Sub

Private Sub cExtender_ColumnDblClick(Button As Integer, ByVal Column As XtremeReportControl.IReportColumn)
    Debug.Print "ColumnDblClick" 
End Sub

Private Sub cExtender_RowDblClick(Button As Integer, ByVal Row As XtremeReportControl.IReportRow, ByVal Item As XtremeReportControl.IReportRecordItem)
    Debug.Print "RowDblClick"
End Sub

' Add this code to a module
Private Declare Function GetDoubleClickTime Lib "user32.dll" () As Long
Private Click As String
Private DblClick As String

Public Function ReportControlDblClick() As Boolean
    If Trim$(Click) = vbNullString Then
        Click = Format$(Date, "yyyymmdd") & Format$(Time, "hhnnss") & Right(Format(Timer, "#0.000"), 3)
    Else
        DblClick = Format$(Date, "yyyymmdd") & Format$(Time, "hhnnss") & Right(Format(Timer, "#0.000"), 3)

        If DblClick - Click < GetDoubleClickTime Then
            ReportControlDblClick = True
            Click = vbNullString
            DblClick = vbNullString
        Else
            Click = Format$(Date, "yyyymmdd") & Format$(Time, "hhnnss") & Right(Format(Timer, "#0.000"), 3)
        End If
        Exit Function
    End If
    
    ReportControlDblClick = False
End Function

Private Sub rpcGrid_MouseDown(Button As Integer, Shift As Integer, x As Long, y As Long)   
    If Button = vbLeftButton Then
        Dim Row As ReportRow
        Set Row = rpcGrid.HitTest(x, y).Row
            Row.Selected = True
    End If
End Sub

Private Sub rpcGrid_MouseUp(Button As Integer, Shift As Integer, x As Long, y As Long)
    If Button = vbLeftButton Then
        If ReportControlDblClick Then
            Select Case rpcGrid.HitTest(x, y).ht
                Case xtpHitTestBlock
                    MsgBox rpcGrid.HitTest(x, y).Block.Caption
            End Select
        End If
    End If
End Sub