Codejock Developer Community : RC Search Highlight Demo w/ Metrics.Text

RC Search Highlight Demo w/ Metrics.Text : Hi jpbroThank you so much.....

Tue, 13 Dec 2011 23:42:06 +0000

Author: JamGodz
Subject: 17718
Posted: 13 December 2011 at 11:42pm

Hi jpbro

Thank you so much.. it really work!

but how i implented the filter to display only the hilighted data in the reportcontrol? using the txtFilter_Change event. But also how you add the flatedit in the toolbar without any problem coz i have successfully attached the flatedit control but when im going to click the control will move to somewhere in the form or to its original position in design time, but when i used vb6 intrinsic control this will not happen..

pls help.

thanks..

RC Search Highlight Demo w/ Metrics.Text : I haven't tested this, but...

Mon, 12 Dec 2011 10:11:35 +0000

Author: jpbro
Subject: 17718
Posted: 12 December 2011 at 10:11am

I haven't tested this, but it might work (may need some modifications, but it should put you on the right track):


Private Sub wndList_BeforeDrawRow(ByVal Row As XtremeReportControl.IReportRow, ByVal Item As XtremeReportControl.IReportRecordItem, ByVal Metrics As XtremeReportControl.IReportRecordItemMetrics)
    If wndList.InplaceEditHwnd <> 0 Then
        If Row Is wndList.FocusedRow Then
            If Item.index = wndList.FocusedColumn.ItemIndex Then
                ' Added code to help avoid a nasty crash when in edit mode when using the Item.Value, using Item.Caption shows the Markup...
                l_Text = Item.Value
                SendMessage wndList(Item.index).InplaceEditHwnd, WM_SETTEXT, 0, ByVal l_Text
                Exit Sub
            End If
        End If
    End If

    Dim GroupRow As ReportGroupRow

    If Row.GroupRow Then
        Set GroupRow = Row
        l_Text = EncodePlainTextForXaml(HTMLClean(GroupRow.GroupCaption))
    Else
        l_Text = EncodePlainTextForXaml(Item.Value)
    End If
    l_Search = EncodePlainTextForXaml(txtFilter.Text)
    
    If LenB(l_Search) <> 0 Then
        l_LastMatchPos = 1
        l_MatchPos = 1

        Do
            l_MatchPos = InStr(l_MatchPos, l_Text, l_Search, vbTextCompare)
            If l_MatchPos > 0 Then
                m_FoundMatch = True

                l_EntitySpacedText = Mid$(l_Text, l_MatchPos, Len(l_Search))
                l_EntitySpacedText = Replace$(l_EntitySpacedText, " ", " ")   ' Make sure leading and trailing spaces get highlighted by using the space entity.

                l_MarkupText = l_MarkupText & Mid$(l_Text, l_LastMatchPos, l_MatchPos - IIf(l_LastMatchPos > l_MatchPos, l_LastMatchPos = l_MatchPos, l_LastMatchPos))
                l_MarkupText = l_MarkupText & "" & l_EntitySpacedText & ""

                l_LastMatchPos = l_MatchPos + Len(l_Search)
                l_MatchPos = l_MatchPos + 1
            Else
                l_MarkupText = l_MarkupText & Mid$(l_Text, l_LastMatchPos)
            End If
        Loop While l_MatchPos > 0

        l_Text = "" & l_MarkupText & ""
    Else
        l_Text = HTMLClean(l_Text)
    End If

    If GroupRow Is Nothing Then
        Item.Caption = l_Text
    Else
        GroupRow.GroupCaption = l_Text
    End If
End Sub

RC Search Highlight Demo w/ Metrics.Text : Hi jpbro and Xander, below...

Sat, 10 Dec 2011 07:41:39 +0000

Author: JamGodz
Subject: 17718
Posted: 10 December 2011 at 7:41am

Hi jpbro and Xander, below is my modification to cater the grouprow highlight.
but it only apply to grouprow coz i only trap to row.grouprow, i need also to filter/highlight the item not only the grouprow.

Pls any suggestion would be greatly appreciated.

Thanks.


Private Sub wndList_BeforeDrawRow(ByVal Row As XtremeReportControl.IReportRow, ByVal Item As XtremeReportControl.IReportRecordItem, ByVal Metrics As XtremeReportControl.IReportRecordItemMetrics)
    If wndList.InplaceEditHwnd <> 0 Then
        If Row Is wndList.FocusedRow Then
            If Item.index = wndList.FocusedColumn.ItemIndex Then
                ' Added code to help avoid a nasty crash when in edit mode when using the Item.Value, using Item.Caption shows the Markup...
                l_Text = Item.Value
                SendMessage wndList(Item.index).InplaceEditHwnd, WM_SETTEXT, 0, ByVal l_Text
                Exit Sub
            End If
        End If
    End If
    
    If Row.GroupRow Then
        Dim GroupRow As ReportGroupRow
        Set GroupRow = Row
        'l_Text = EncodePlainTextForXaml(Item.Value)
        l_Text = EncodePlainTextForXaml(HTMLClean(GroupRow.GroupCaption))
        l_Search = EncodePlainTextForXaml(txtFilter.Text)
             
        If LenB(l_Search) <> 0 Then
            l_LastMatchPos = 1
            l_MatchPos = 1
            Do
                l_MatchPos = InStr(l_MatchPos, l_Text, l_Search, vbTextCompare)
                If l_MatchPos > 0 Then
                    m_FoundMatch = True
    
                    l_EntitySpacedText = Mid$(l_Text, l_MatchPos, Len(l_Search))
                    l_EntitySpacedText = Replace$(l_EntitySpacedText, " ", " ")   ' Make sure leading and trailing spaces get highlighted by using the space entity.
    
                    l_MarkupText = l_MarkupText & Mid$(l_Text, l_LastMatchPos, l_MatchPos - IIf(l_LastMatchPos > l_MatchPos, l_LastMatchPos = l_MatchPos, l_LastMatchPos))
                    l_MarkupText = l_MarkupText & "" & l_EntitySpacedText & ""
    
                    l_LastMatchPos = l_MatchPos + Len(l_Search)
                    l_MatchPos = l_MatchPos + 1
                Else
                    l_MarkupText = l_MarkupText & Mid$(l_Text, l_LastMatchPos)
                End If
            Loop While l_MatchPos > 0
            GroupRow.GroupCaption = "" & l_MarkupText & ""
        Else
            GroupRow.GroupCaption = HTMLClean(l_Text)
        End If
    End If
End Sub

below are my function to strip HTML tags.


Public Function HTMLClean(ByVal strText As String) As String
    Dim objRegEx As VBScript_RegExp_55.RegExp
   
    ' replace 
's for a newline
    strText = Replace$(strText, "
", Chr$(10), 1, -1, vbTextCompare)
   
    ' replace non-breaking spaces for a space
    strText = Replace$(strText, " ", Chr$(32), 1, -1, vbTextCompare)
   
    ' create new regex object
    Set objRegEx = New VBScript_RegExp_55.RegExp
    objRegEx.Global = True ' don't just operate on first find.
   
    ' remove HTML tags
    objRegEx.Pattern = "<[^>]*>"
    strText = objRegEx.Replace(strText, "")
   
    ' ditch excessive white space
    objRegEx.Pattern = "\s+"
    strText = objRegEx.Replace(strText, " ")

    Set objRegEx = Nothing

    ' named-entities
    strText = Replace$(strText, ">", ">", 1, -1, vbTextCompare)
    strText = Replace$(strText, "<", "<", 1, -1, vbTextCompare)

    ' insert your favourite named-entities here.
    strText = Replace$(strText, "&", "&", 1, -1, vbTextCompare)  ' must do last
   
    ' return
    HTMLClean = strText
End Function

[]

RC Search Highlight Demo w/ Metrics.Text : At the top of the BeforeDrawRow...

Fri, 09 Dec 2011 13:58:18 +0000

Author: jpbro
Subject: 17718
Posted: 09 December 2011 at 1:58pm

At the top of the BeforeDrawRow event, you could test like this:


If Row Is Nothing Then Exit Sub
If Row.GroupRow Then Exit Sub
If Item Is Nothing Then Exit Sub

This should prevent any errors (aircode, so hopefully I haven't made a mistake).

RC Search Highlight Demo w/ Metrics.Text : Hi JamGodz,I guess this issue...

Fri, 09 Dec 2011 03:31:00 +0000

Author: Xander75
Subject: 17718
Posted: 09 December 2011 at 3:31am

Hi JamGodz,

I guess this issue is occuring due to the use of the GroupRow. I didn't test for that as I wasn't using it in my project, but I guess you'll need to add some code for Row.GroupRow.

If you can upload a sample I will try and help you out, although now that this forum takes a while for posts to display I can't imagine I can help before the weekend plus I am out of the office on Monday & Tuesday!

RC Search Highlight Demo w/ Metrics.Text : Hi Xander! thank you for the...

Thu, 08 Dec 2011 03:26:00 +0000

Author: JamGodz
Subject: 17718
Posted: 08 December 2011 at 3:26am

Hi Xander! thank you for the reply and specially the code..
but i have found an error in

l_Text = EncodePlainTextForXaml(Item.Value)

its says "Object Variable or With block variable not set"

i have a 2 grouprow in my RC. how can avoid this error?

and it doesnt hightlight the grouprow.

thanks?

RC Search Highlight Demo w/ Metrics.Text : Hi JamGodz,Well as for the...

Tue, 06 Dec 2011 05:13:56 +0000

Author: Xander75
Subject: 17718
Posted: 06 December 2011 at 5:13am

Hi JamGodz,

Well as for the code you can get this from jpbro's first post and change the code accordinly as per my fifth post.

As for the filter, well it's nothing more than a FlatEdit & PushButton control. I changed the way in which the filter worked by disabling and enabling a timer each time the filter was changed so as that it meant it would only filter after a few seconds of inactivity.

Private Sub tmrFilter_Timer()
    tmrFilter.Enabled = False
    Dim i As Long
    
    m_FoundMatch = False
    
    For i = 0 To 3
        With rpcGrid(i)
            .FilterText = Trim$(txtFilter.Text)
            .Navigator.MoveFirstVisibleRow
            .Populate
            .Redraw
        End With
    Next
    
    If LenB(txtFilter.Text) > 0 Then
        If m_FoundMatch Then
            For i = 0 To 3
                rpcGrid(i).ExpandAll True
            Next
            txtFilter.BackColor = vbWindowBackground
        Else
            txtFilter.BackColor = &H8282FF
        End If
    Else
        For i = 0 To 3
            rpcGrid(i).CollapseAll
        Next
        txtFilter.BackColor = vbWindowBackground
    End If
    
    For i = 0 To 3
        With rpcGrid(i)
            .Navigator.MoveFirstVisibleRow
        End With
    Next
End Sub

Private Sub txtFilter_Change()
    tmrFilter.Enabled = False
    tmrFilter.Enabled = True
    If Trim$(txtFilter.Text) = vbNullString Then Call tmrFilter_Timer
End Sub

As for the checkbox "Highlight Filtered Text", I added this later on and this can be added in the BeforeDrawRow event, simlpy replace the block of code in post five:

' Right Align Numeric Values
If IsNumeric(l_Text) Then
    Row.Record.Item(Item.Index).Caption = "" & l_MarkupText & ""
Else
    Row.Record.Item(Item.Index).Caption = "" & l_MarkupText & ""
End If

with the following code:

If CommandBars.FindControl(, ID_TOOLBAR_FILTER_HIGHLIGHT).Checked Then
    ' Right Align Numeric Values
    If IsNumeric(l_Text) Then
        Row.Record.Item(Item.Index).Caption = "" & l_MarkupText & ""
    Else
        Row.Record.Item(Item.Index).Caption = "" & l_MarkupText & ""
    End If
Else
    Row.Record.Item(Item.Index).Caption = l_Text
End If

RC Search Highlight Demo w/ Metrics.Text : Hi Sir Xander! Good Day!Just want...

Sat, 19 Nov 2011 06:26:09 +0000

Author: JamGodz
Subject: 17718
Posted: 19 November 2011 at 6:26am

Hi Sir Xander! Good Day!

Just want to know of how you do it, the filter function... can you teach/post some sample code?
i saw your screenshot and that's all i need especially those above the reportcontrol... please...

Thank you.

RC Search Highlight Demo w/ Metrics.Text : Hi Aaron,The crash only...

Fri, 29 Jul 2011 05:51:51 +0000

Author: Xander75
Subject: 17718
Posted: 29 July 2011 at 5:51am

Hi Aaron,

The crash only happened as I had changed the line:

    SendMessage rpcGrid(Index).InplaceEditHwnd, WM_SETTEXT, 0, ByVal Item.Caption

    SendMessage rpcGrid(Index).InplaceEditHwnd, WM_SETTEXT, 0, ByVal Item.Value

However by updating the code to:

    l_Text = Item.Value
    SendMessage rpcGrid(Index).InplaceEditHwnd, WM_SETTEXT, 0, ByVal l_Text

Helps fix the crashing issue and displays the text in edit mode correctly, although there is a slight flicker of Markup.

I have updated my previous post above with this fix.

RC Search Highlight Demo w/ Metrics.Text : Hi Alexander, I tried your...

Fri, 29 Jul 2011 05:37:33 +0000

Author: Aaron
Subject: 17718
Posted: 29 July 2011 at 5:37am

Hi Alexander,

I tried your code with V15.0.2 and it works OK, at least no crash.