Searching Text

[lavarock09]

How do I search text for a certain peice of text,

I want to do a bbcode thing, so it takes bbcode and makes it into text with all the formatting, so I want it to be able to find 2 things, e.g. [/b] and [//b] and ignore the text inbetween, e.g. [/b]Hi[//b]

I want it to find the [/b] and the [//b] and the output to make Hi bold,

Is this possible in VB? and if so, how would I do it?

Ignore the extra slash, it was making the text bold

[dglienna]

You search like this:

Dim pos as integer
pos = instr(text1.text,"/b") ' will return 0 if not found, or the position if it is

Not sure exactly what you want. Usually, we get the text in between two tags.

[lavarock09]

well, that doesn't seem to do anyhting,

what I want is, when in the textbox you type

[//b]Hi All[///b] (ignore the 2 extra slashes)

It outputs Hi All into a textbox

[MartinLiss]

You won't be able to do that in a textbox but you can with a RichTextbox. Give me a few minutes and I'll have an example.

[lavarock09]

richtextbox is fine, as long as it works

[MartinLiss]

OK here's an example.

Option Explicit
Private Const BOLDSTART = "[//b]"
Private Const BOLDEND = "[///b]"
Private Sub Form_Load()
 
End Sub
 
 
Private Sub RichTextBox1_Change()
 
    Dim intStart As Integer
    Dim intEnd As Integer
    
    intStart = InStr(1, RichTextBox1.Text, BOLDSTART)
    intEnd = InStr(1, RichTextBox1.Text, BOLDEND)
    
    If intStart > 0 And intEnd > 0 Then
        RichTextBox1.Text = Replace(RichTextBox1.Text, BOLDSTART, "")
        RichTextBox1.Text = Replace(RichTextBox1.Text, BOLDEND, "")
        RichTextBox1.SelStart = intStart - 1
        RichTextBox1.SelLength = intEnd - intStart
        RichTextBox1.SelBold = True
        RichTextBox1.SelStart = Len(RichTextBox1.Text)
        RichTextBox1.SelBold = False
    End If
    
    
End Sub

This only works for the last bold words. To make it work for more than one pair of tags you'll need to either wait until the user is done and have them hit a button to convert all the tags at once, or you'll need to maintain an array of intStart and intEnd values for each par of tags and redo the bolding for all the words each time a new one is found.

[lavarock09]

That seems to do the trick, I can do the same for Underline and bold, it should be just a case of changing a few words.

How would I do url's?

[lavarock09]

Ah, I now have a problem

I have added Underline

this is my code

Option Explicit
Private Const BOLDSTART = "[//b]"
Private Const BOLDEND = "[///b]"
Private Const UNDERSTART = "[//u]"
Private Const UNDEREND = "[///u]"
Private Sub RichTextBox1_Change()
 
    Dim intStart As Integer
    Dim intEnd As Integer
        intStart = InStr(1, RichTextBox1.Text, BOLDSTART)
    intEnd = InStr(1, RichTextBox1.Text, BOLDEND)
    
    
        End Sub
        
Private Sub Command1_Click()
Dim intStart As Integer
    Dim intEnd As Integer
        intStart = InStr(1, RichTextBox1.Text, BOLDSTART)
    intEnd = InStr(1, RichTextBox1.Text, BOLDEND)
If intStart > 0 And intEnd > 0 Then
        RichTextBox1.Text = Replace(RichTextBox1.Text, BOLDSTART, "")
        RichTextBox1.Text = Replace(RichTextBox1.Text, BOLDEND, "")
        RichTextBox1.SelStart = intStart - 1
        RichTextBox1.SelLength = intEnd - intStart
        RichTextBox1.SelBold = True
        RichTextBox1.SelStart = Len(RichTextBox1.Text)
        RichTextBox1.SelBold = False
    End If
    Dim intStart2 As Integer
    Dim intEnd2 As Integer
        intStart2 = InStr(1, RichTextBox1.Text, UNDERSTART)
    intEnd2 = InStr(1, RichTextBox1.Text, UNDEREND)
If intStart2 > 0 And intEnd2 > 0 Then
        RichTextBox1.Text = Replace(RichTextBox1.Text, UNDERSTART, "")
        RichTextBox1.Text = Replace(RichTextBox1.Text, UNDEREND, "")
        RichTextBox1.SelStart = intStart2 - 1
        RichTextBox1.SelLength = intEnd2 - intStart
        RichTextBox1.SelUnderline = True
        RichTextBox1.SelStart = Len(RichTextBox1.Text)
        RichTextBox1.SelUnderline = False
    End If
End Sub

but it makes some letters after the [///b] bold

[MartinLiss]

I haven't tested it but it looks like this may be a part of the problem.

RichTextBox1.SelLength = intEnd2 - intStart

should be

RichTextBox1.SelLength = intEnd2 - intStart2

[lavarock09]

In the richtextbox I have typed,

[//b]Hi[///b]
[//u]Hi[///u]

and it outputs

Hi
Hi

[dglienna]

I don't think you should use the change event to do formatting. The click event should take care of it. You'd have to keep track of the position in the change event to know what you want to format.

[lavarock09]

I'm using the click event, I changed it

[dglienna]

I just got this working in the changed event: seems to work

Private Sub RichTextBox1_Change()
  Static intStart1 As Integer
  Static intEnd1 As Integer
  Static intStart2 As Integer
  Static intEnd2 As Integer
  intStart1 = InStr(1, RichTextBox1.Text, BOLDSTART)
  If intStart1 > 0 Then
    intEnd1 = InStr(intStart1, RichTextBox1.Text, BOLDEND)
  End If
  If intEnd1 > 0 Then
    RichTextBox1.Text = Replace(RichTextBox1.Text, BOLDSTART, "")
    RichTextBox1.Text = Replace(RichTextBox1.Text, BOLDEND, "")
    RichTextBox1.SelStart = intStart1 - 1
    RichTextBox1.SelLength = intEnd1 - intStart1
    RichTextBox1.SelBold = True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
    RichTextBox1.SelBold = False
    intEnd1 = 0
  End If
  intStart2 = InStr(1, RichTextBox1.Text, UNDERSTART)
  If intStart2 > 0 Then
    intEnd2 = InStr(intStart2, RichTextBox1.Text, UNDEREND)
  End If
  If intEnd2 > 0 Then
    RichTextBox1.Text = Replace(RichTextBox1.Text, UNDERSTART, "")
    RichTextBox1.Text = Replace(RichTextBox1.Text, UNDEREND, "")
    RichTextBox1.SelStart = intStart2 - 1
    RichTextBox1.SelLength = intEnd2 - intStart2
    RichTextBox1.SelUnderline = True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
    RichTextBox1.SelUnderline = False
    intEnd2 = 0
  End If
End Sub

[MartinLiss]

What's the point of making the variables Static?

[dglienna]

So it didn't keep redimming them, just to save some time, I guess. I was going to implement a position counter (which would have had to be static) but decided that as long as the formatting tags were being deleted, the position didn't matter.

[lavarock09]

I just got this working in the changed event: seems to work

Private Sub RichTextBox1_Change()
  Static intStart1 As Integer
  Static intEnd1 As Integer
  Static intStart2 As Integer
  Static intEnd2 As Integer
  intStart1 = InStr(1, RichTextBox1.Text, BOLDSTART)
  If intStart1 > 0 Then
    intEnd1 = InStr(intStart1, RichTextBox1.Text, BOLDEND)
  End If
  If intEnd1 > 0 Then
    RichTextBox1.Text = Replace(RichTextBox1.Text, BOLDSTART, "")
    RichTextBox1.Text = Replace(RichTextBox1.Text, BOLDEND, "")
    RichTextBox1.SelStart = intStart1 - 1
    RichTextBox1.SelLength = intEnd1 - intStart1
    RichTextBox1.SelBold = True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
    RichTextBox1.SelBold = False
    intEnd1 = 0
  End If
  intStart2 = InStr(1, RichTextBox1.Text, UNDERSTART)
  If intStart2 > 0 Then
    intEnd2 = InStr(intStart2, RichTextBox1.Text, UNDEREND)
  End If
  If intEnd2 > 0 Then
    RichTextBox1.Text = Replace(RichTextBox1.Text, UNDERSTART, "")
    RichTextBox1.Text = Replace(RichTextBox1.Text, UNDEREND, "")
    RichTextBox1.SelStart = intStart2 - 1
    RichTextBox1.SelLength = intEnd2 - intStart2
    RichTextBox1.SelUnderline = True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
    RichTextBox1.SelUnderline = False
    intEnd2 = 0
  End If
End Sub

This still doesn't stop this happening,

Input

[//b]Hi[///b]
[//u]Hi[///u]

Output

Hi
Hi

[MartinLiss]

Sorry about that. There were some mistakes in my original code.

Option Explicit
Private Const BOLDSTART = "[//b]"
Private Const BOLDEND = "[///b]"
Private Const UNDERSTART = "[//u]"
Private Const UNDEREND = "[///u]"
        
Private Sub Command1_Click()
Dim intStart As Integer
Dim intEnd As Integer
Dim intStart2 As Integer
Dim intEnd2 As Integer
 
intStart = InStr(1, RichTextBox1.Text, BOLDSTART) + Len(BOLDSTART)
intEnd = InStr(1, RichTextBox1.Text, BOLDEND) - 1
intStart2 = InStr(1, RichTextBox1.Text, UNDERSTART) + Len(UNDERSTART)
intEnd2 = InStr(1, RichTextBox1.Text, UNDEREND) - 1
 
If intStart > 0 And intEnd > 0 Then
    RichTextBox1.SelStart = intStart - 1
    RichTextBox1.SelLength = intEnd - intStart + 1
    RichTextBox1.SelBold = True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
    RichTextBox1.SelBold = False
End If
If intStart2 > 0 And intEnd2 > 0 Then
    RichTextBox1.SelStart = intStart2 - 1
    RichTextBox1.SelLength = intEnd2 - intStart2 + 1
    RichTextBox1.SelUnderline = True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
    RichTextBox1.SelUnderline = False
End If
 
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, BOLDSTART, "")
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, BOLDEND, "")
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, UNDERSTART, "")
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, UNDEREND, "")

[lavarock09]

Thanks, thats alot better, but how would I go about doing URL's and IMG's

[MartinLiss]

Here is code for the url that I copied and modified slightly from a post by manovo11. Note that the url tags aren't necessary with this code but I included them for consistency.

Option Explicit
 
Private Const WM_USER As Long = &H400
Private Const EM_AUTOURLDETECT As Long = (WM_USER + 91)
Private Const EM_GETSEL As Long = &HB0
 
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 Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
     ByVal hwnd As Long, _
     ByVal lpOperation As String, _
     ByVal lpFile As String, _
     ByVal lpParameters As String, _
     ByVal lpDirectory As String, _
     ByVal nShowCmd As Long) As Long
 
 
Private Const BOLDSTART = "[//b]"
Private Const BOLDEND = "[///b]"
Private Const UNDERSTART = "[//u]"
Private Const UNDEREND = "[///u]"
Private Const URLSTART = "[//url]"
Private Const URLEND = "[///url]"
 
        
Private Sub Command1_Click()
Dim intStart As Integer
Dim intEnd As Integer
Dim intStart2 As Integer
Dim intEnd2 As Integer
 
intStart = InStr(1, RichTextBox1.Text, BOLDSTART) + Len(BOLDSTART)
intEnd = InStr(1, RichTextBox1.Text, BOLDEND) - 1
intStart2 = InStr(1, RichTextBox1.Text, UNDERSTART) + Len(UNDERSTART)
intEnd2 = InStr(1, RichTextBox1.Text, UNDEREND) - 1
 
If intStart > 0 And intEnd > 0 Then
    RichTextBox1.SelStart = intStart - 1
    RichTextBox1.SelLength = intEnd - intStart + 1
    RichTextBox1.SelBold = True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
    RichTextBox1.SelBold = False
End If
If intStart2 > 0 And intEnd2 > 0 Then
    RichTextBox1.SelStart = intStart2 - 1
    RichTextBox1.SelLength = intEnd2 - intStart2 + 1
    RichTextBox1.SelUnderline = True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
    RichTextBox1.SelUnderline = False
End If
 
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, BOLDSTART, "")
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, BOLDEND, "")
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, UNDERSTART, "")
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, UNDEREND, "")
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, URLSTART, "")
RichTextBox1.TextRTF = Replace(RichTextBox1.TextRTF, URLEND, "")
DetectURL RichTextBox1, True
 
End Sub
 
Private Sub DetectURL(p_RichText As Object, p_blnDetect As Boolean)
    Dim lngRet As Long
    Dim strText As String
    
    With p_RichText
        ' this line is needed because the function will not update the
        ' url if you had it before
        strText = .TextRTF
        ' send message to detect urls
        ' notice the Abs function. This is needed to pass 0 or 1
        ' in VB true is -1, so we have to get the absolute value of that
        lngRet = SendMessage(RichTextBox1.hwnd, EM_AUTOURLDETECT, Abs(p_blnDetect), ByVal 0)
        ' rewrite the text into the RichText so it will change all URLs if you
        'had them before
        .TextRTF = strText
    End With
End Sub
 
Private Sub Form_Load()
 
    RichTextBox1.Text = "[//b]hi[///b]The URL to click is [url]http://www.vbforums.com[/url].  Please click it." & vbCrLf
    
End Sub
 
Private Sub RichTextBox1_Change()
'    DetectURL RichTextBox1, True
'    RichTextBox1.SelStart = Len(RichTextBox1.Text)
End Sub
 
 
Private Sub RichTextBox1_Click()
 
    Dim lngRetVal As Long
    
    lngRetVal = SendMessage(RichTextBox1.hwnd, EM_GETSEL, 0, 0)
    
    Dim strBuffer As String, intInStr As Integer, intHi As Integer, intLo As Integer
    
    intHi = HiWord(lngRetVal) + 1
    intLo = LoWord(lngRetVal) + 1
    
    intInStr = InStrRev(RichTextBox1.Text, " ", intLo)
    
    If intInStr = 0 Then 'no space
        strBuffer = Mid(RichTextBox1.Text, 1, intLo)
    Else
        strBuffer = Mid(RichTextBox1.Text, intInStr + 1)
    End If
    
    strBuffer = Trim(strBuffer)
    intInStr = InStr(1, strBuffer, " ")
    
    If intInStr <> 0 Then
        strBuffer = Mid(strBuffer, 1, intInStr - 1)
    End If
    
    If InStr(1, strBuffer, "http:") = 0 And _
        InStr(1, strBuffer, "file:") = 0 And _
        InStr(1, strBuffer, "mailto:") = 0 And _
        InStr(1, strBuffer, "ftp:") = 0 And _
        InStr(1, strBuffer, "https:") = 0 And _
        InStr(1, strBuffer, "gopher:") = 0 And _
        InStr(1, strBuffer, "nntp:") = 0 And _
        InStr(1, strBuffer, "prospero:") = 0 And _
        InStr(1, strBuffer, "telnet:") = 0 And _
        InStr(1, strBuffer, "news:") = 0 And _
        InStr(1, strBuffer, "wais:") = 0 Then Exit Sub
        
    Debug.Print strBuffer
    
End Sub
 
Private Function LoWord(ByVal DWord As Long) As Long
  If DWord And &H8000& Then
    LoWord = DWord Or &HFFFF0000
  Else
    LoWord = DWord And &HFFFF&
  End If
End Function
 
Private Function HiWord(ByVal DWord As Long) As Long
  HiWord = (DWord And &HFFFF0000) \ &H10000
End Function

[lavarock09]

The url doesn't work, it turns into and underlined blue link, but when I click it, it does nothing

[MartinLiss]

Change the bottom of the Richtextbox click event to

'Debug.Print strBuffer
     Call ShellExecute(Me.hwnd, "OPEN", strBuffer, vbNullString, vbNullString, 5)

[chemicalNova]

You probably want to check for more than a space after the end of the URL, as it is now it will include a "." (dot) character in the URL when you click it. This is because it only takes away from a space and the string after the URL is ". Please click it". Hence the dot. To make it foolproof, check for dots, question marks, exclamation marks, etc aswell.

chem

[lavarock09]

You probably want to check for more than a space after the end of the URL, as it is now it will include a "." (dot) character in the URL when you click it. This is because it only takes away from a space and the string after the URL is ". Please click it". Hence the dot. To make it foolproof, check for dots, question marks, exclamation marks, etc aswell.

chem

Explain

Marty, I in the box i have typed my website address, http://www.m3xvv.co.uk

and if I click inbetween the 3 and the x it opens up IE, but the address bar and site only points to http://www.m3/

[MartinLiss]

As I mentioned it's not my code but I'll try to figure out what is wrong.

[lavarock09]

Thanks

[eyeRmonkey]

Please follow the instructions in my signature to mark your thread as resolved if your question has been answered. Thanks.

[MartinLiss]

Unfortunately I don't understand the HiWord and LoWord code but the problem seems to lie there. I found however that if you modify the RichTextBox1_Click like I show below, it will work. However since I really don't understand what's going on, you may have problems with other urls.

'    If intInStr = 0 Then 'no space
'        strBuffer = Mid(RichTextBox1.Text, 1, intLo)
'    Else
        strBuffer = Mid(RichTextBox1.Text, intInStr + 1)
'    End If