Reverse Find for Richtext 2

[three57m]

I am trying to figure out why this code
will not step through and find text if settingQ is not zero

Public Sub prevFindTextInstrQ(strToFindQ As String, settingsQ As Long)
    Dim entireStrQ As String
    's_startQ is public declare long
    'setting options for reverse find
    'allmatches = 0
    'rtfWholeWord = 2
    'rtfMatchCase = 4
    'rtfWholeWord & rtfMatchCase = 6
    
    entireStrQ = callingRichText.Text
    
    s_startQ = s_startQ - Len(strToFindQ)
    If s_startQ <= 0 Then
        s_startQ = -1
    Else
    End If
    
    s_startQ = InStrRev(entireStrQ, strToFindQ, s_startQ, vbTextCompare)
    s_startQ = s_startQ - Len(strToFindQ)
    If s_startQ <= -1 Then
        s_startQ = 0
    Else
    End If
    s_startQ = callingRichText.Find(strToFindQ, s_startQ, , settingsQ)
    
    
    If s_startQ = -1 Then 'allows user to loop back
        s_startQ = InStrRev(entireStrQ, strToFindQ, s_startQ, vbTextCompare)
        s_startQ = s_startQ - Len(strToFindQ)
        If s_startQ <= -1 Then
            s_startQ = 0
        Else
        End If
        s_startQ = callingRichText.Find(strToFindQ, s_startQ, , settingsQ)
    Else
    End If
End Sub

sorry if this is kinda sloppy to read

 

[SBerthold]

Why are you doing this?:

s_startQ = s_startQ - Len(strToFindQ)

 

[three57m]

<Why are you doing this?>
I wish I had a good answer. but i dont, i am getting closer to a solid solution and if it works perfectly i will post it.

 

[strongm]

I'm still trying to figure out what your actual goal is ...

 

[dglienna]

You should keep track of the last searches (maybe 100)?
Because the RTB doesn't have a way to search backwards, you can try InStrRev(), which DOES search backwards, but only for text. That's prolly what you need, though.

-David
2006 & 2007 Microsoft Most Valuable Professional (MVP)
2006 Dell Certified System Professional (CSP)

 

[strongm]

Eh? The OP already uses InStrRev, so I'm not sure what you are trying to say here.

 

[three57m]

main goal is to allow a find next and find previous function to loop through the found items in a richtext

Here is why I am trying to use the .find method as opposed to just instrrev.

I have the richtext on form1
form2 is the find next and find previous form
the richtextbox property hideselection is set to false
setting this property to false allows the find function to highlight the found string. if i use rtb.setfocus after instrrev finds the text "which i would have to if using just instrrev" form1 and form2 will both flash. so basically it would be easiest to eliminate the use of .find and create a simple instrrev with a .setfocus sub routine for the reverse but it just doesnt have a real polished feal to it.

 

[three57m]

Sorry i forgot to mention i would also like to support wholeword and matchcase which instrrev will do match case but not wholeword

 

[strongm]

Great. You can do all that with your RTB.

Here's the trivial finding of the previous instance of some text in an RTB:

Option Explicit

Private Sub Command1_Click()
' Just highlight some text in the RTB, and then clicking command
' will find and highlight previous instance of matching text
prevFindText
End Sub

Public Sub prevFindText()
Dim result As Long
Dim sellen As Long

sellen = callingRichText.SelLength
result = InStrRev(Left(callingRichText.Text, callingRichText.SelStart), callingRichText.SelText) - 1
If Not result Then
callingRichText.SelStart = result
callingRichText.SelLength = sellen
End If
callingRichText.SetFocus
End Sub

But we can do much better than that and just use the RTB itself for forward and backward searching - but it's 01:35 in the morning here so I'm going to bed for now ...

 

[strongm]

And here's the RTB only version. No InstrRev or positional calculations required. You'll neeed a project with a form, an RTB, a text box, two command buttons and two checkboxes. You'll also need to add a reference to 'tom' (Text Object Model), which provides an alternative interface to the RTB that is much more flexible than the default. (If tom does not appear in your list of available references, Browse in System32 for Riched20.dllShell).

[blue]Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400&
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)

Dim tomDoc As ITextDocument

Private Enum Direction
    Forward = 1
    Backward = -1
End Enum

Private Sub Command1_Click()
RTFindText Text1.Text, Forward
End Sub

Private Sub Command2_Click()
    RTFindText Text1.Text, Backward
End Sub

' All the hard work done here
Private Sub RTFindText(strText As String, Optional RequiredDirection As Direction = Forward)
    Dim flags As Long
    flags = 2 * Check1 + 4 * Check2 ' + 8 * Check3 sadly, RegExp functionality is not available on a RichTextBox
    tomDoc.Selection.FindText Text1.Text, RequiredDirection * tomDoc.Selection.StoryLength, flags
End Sub

Private Sub Form_Load()
    Dim myIUnknown As IUnknown ' Bet you didn't know that VB actually knows about IUnknown ...

    ' Get alternative TOM interface to RTB
    SendMessage RichTextBox1.hwnd, EM_GETOLEINTERFACE, 0&, myIUnknown
    Set tomDoc = myIUnknown ' We're doing a QueryInterface!
    
    ' Ok, set up our RTB with some text
    RichTextBox1.Text = "hello and Hello and hEllo or hello with another hello just for luck saying hello there"
    RichTextBox1.HideSelection = False 'Always show highlight, whether RTB has focus or not
    
    Text1.Text = "Hello" ' Default word to search for
    Command1.Caption = "Find Next"
    Command2.Caption = "Find Previous"
    Check1.Caption = "Whole word"
    Check2.Caption = "Case"
    ' Check3.Caption = "RegExp" 'Sadly RegExp functionality is not available on a RichTextBox
End Sub[/blue]

 

[dglienna]

Great stuff there!

You have an extra SHELL in there though.

Browse in System32 for Riched20.dll

-David
2006 & 2007 Microsoft Most Valuable Professional (MVP)
2006 Dell Certified System Professional (CSP)

 

[strongm]

Dratted typo ...

 

[three57m]

<Great stuff there!>



I could not agree more, this is GREAT stuff. After alot of messing around trying to figure this one out, much relief to have this quality of help.

star for strongm

 

[dglienna]

Anything similar for getting images OUT of a RTB? It's equivalent for objects rather than text?

-David
2006 & 2007 Microsoft Most Valuable Professional (MVP)
2006 Dell Certified System Professional (CSP)

 

[strongm]

Can't you just use the RTB's OLEObjects collection?

 

[dglienna]

Here it is in a nutshell:

...i have read some stuff that tells how to convert a picture into richtextformat, but i am looking to do the reverse to that

he wants to send it out in an email.

he wants to take the object, and be able to encode into an email.


-David
2006 & 2007 Microsoft Most Valuable Professional (MVP)
2006 Dell Certified System Professional (CSP)

 

[strongm]

Ah - so the issue isn't finding the embedded image, the issue is how do we turn it into something more useable (in VB) than an IDataObject.

That may be better addressed in a seperate thread.

 

[dglienna]

More or less, detecting the type of object, and then encoding it. I'll mention it to him, and see if he wants me to post a thread. Maybe I'll get him to join us.

-David
2006 & 2007 Microsoft Most Valuable Professional (MVP)
2006 Dell Certified System Professional (CSP)

 

[three57m]

In Case anyone is intested here is a version that functions exactly like the Riched20.dll posting by strongm but does not rely on any API calls.

To Try Add: 1 RichtextBox , 2 CommandButtons
2 Checkboxes, 1 Textbox. Then Add a module to the project.
Paste the form code to form and the module code to module.

Option Explicit

'PASTE TO FORM

Private Sub Command1_Click()
    Dim findSettingsQ As Long
    'SEARCH SETTINGS
    'AllMatches 0
    'rtfWholeWord 2
    'rtfMatchCase 4
    'rtfWholeWord & rtfMatchCase 6
    If Check1.Value = 1 And Check2.Value = 1 Then
        findSettingsQ = 6
    ElseIf Check1.Value = 1 And Check2.Value = 0 Then
        findSettingsQ = 2
    ElseIf Check1.Value = 0 And Check2.Value = 1 Then
        findSettingsQ = 4
    ElseIf Check1.Value = 0 And Check2.Value = 0 Then
        findSettingsQ = 0
    End If
    forwardFindStr Text1.Text, findSettingsQ
End Sub

Private Sub Command2_Click()
    Dim findSettingsQ As Long
    'SEARCH SETTINGS
    'AllMatches 0
    'rtfWholeWord 2
    'rtfMatchCase 4
    'rtfWholeWord & rtfMatchCase 6
    If Check1.Value = 1 And Check2.Value = 1 Then
        findSettingsQ = 6
    ElseIf Check1.Value = 1 And Check2.Value = 0 Then
        findSettingsQ = 2
    ElseIf Check1.Value = 0 And Check2.Value = 1 Then
        findSettingsQ = 4
    ElseIf Check1.Value = 0 And Check2.Value = 0 Then
        findSettingsQ = 0
    End If
    reverseFindStr Text1.Text, findSettingsQ
End Sub


Private Sub Form_Load()
    Set callingRichTxt = RichTextBox1
    Text1.Text = "Hello"
    Command1.Caption = "Find Next"
    Command2.Caption = "Find Previous"
    Check1.Caption = "Whole Word"
    Check2.Caption = "Case"
    RichTextBox1.Text = "hello and Hello and hEllo or hello with another hello just for luck saying hello there helLothere"
    RichTextBox1.HideSelection = False
End Sub

'PASTE IN MODULE
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit


Public s_startQ As Long
Public e_endQ As Long
Public prevFindStr As String
Public callingRichTxt As RichTextBox
    
Public Sub forwardFindStr(strToFindQ As String, searchSettingsQ As Long)
    Dim lenOfFindStr As Long
    
    lenOfFindStr = Len(strToFindQ)
    
    If prevFindStr = strToFindQ Then
        If callingRichTxt.SelStart = s_startQ Then
            s_startQ = s_startQ + lenOfFindStr
        Else
            s_startQ = callingRichTxt.SelStart
        End If
    Else
        'new search start from carot position
        s_startQ = callingRichTxt.SelStart
    End If
    e_endQ = Len(callingRichTxt.Text)
    
    s_startQ = callingRichTxt.Find(strToFindQ, s_startQ, e_endQ, searchSettingsQ)
    
    If s_startQ = -1 Then
        'match not found
    Else
        'set the reverse start value
        prevFindStr = strToFindQ
    End If
End Sub

Public Sub reverseFindStr(strToFindQ As String, searchSettingsQ As Long)
    Dim lenOfFindStr As Long
    Dim instrRevQ As Long
    Dim stepCountQ As Integer
    
    lenOfFindStr = Len(strToFindQ)
    
    If prevFindStr = strToFindQ Then
        If callingRichTxt.SelStart > 0 Then
            e_endQ = callingRichTxt.SelStart
        ElseIf callingRichTxt.SelStart = 0 Then
            e_endQ = lenOfFindStr
        ElseIf callingRichTxt.SelStart + lenOfFindStr = Len(callingRichTxt.Text) Then
            e_endQ = callingRichTxt.SelStart
        Else
            e_endQ = -1
        End If
    ElseIf callingRichTxt.SelStart = 0 Then
        e_endQ = -1
    Else
        e_endQ = callingRichTxt.SelStart
    End If
    
    'allow instrRev to find before testing with .find for a wholeword/case match
    For stepCountQ = 1 To Len(callingRichTxt.Text)
    instrRevQ = InStrRev(callingRichTxt.Text, strToFindQ, e_endQ, vbTextCompare)
    If instrRevQ <= 0 Then
        'MATCH NOT FOUND
        
    Else
        'TEST FOR VALID MATCH WITH .FIND
        If instrRevQ - lenOfFindStr < 0 Then
            e_endQ = callingRichTxt.Find(strToFindQ, 0, e_endQ, searchSettingsQ)
        Else
            e_endQ = callingRichTxt.Find(strToFindQ, instrRevQ - lenOfFindStr, e_endQ, searchSettingsQ)
        End If
        
        If e_endQ = -1 Then
            'INVALID MATCH
            e_endQ = instrRevQ - lenOfFindStr
            If e_endQ <= 0 Then
                e_endQ = lenOfFindStr
            Else
            End If
        Else
            'SEARCH COMPLETE
            s_startQ = e_endQ
            Exit Sub
        End If
    End If
    Next stepCountQ
    
End Sub

 

[strongm]

I know which I prefer ...