We help IT Professionals succeed at work.

RichTextBox LinkClicked not returning hidden text

purplepomegranite
purplepomegranite used Ask the Experts™
on
I have an odd problem.  I am using a customised RichTextBox control (System.Windows.Forms.RichTextBox) that displays custom links (by inserting the text then applying CFE_LINK effect to the inserted text).  However, I need some extra information that I do not want displayed in the richtextbox.  This information I write as text to the link, and apply CFE_HIDDEN effect to it.

The problem is that I am not receiving the extra text when the dll is called from the actual target app (though am in my test app).

The RTB is in a custom control in a dll.  For testing, I call this from a basic .Net app.  In testing, the LinkClicked event returns the expected text - both hidden and unhidden.  This is what I need.

When I use the same form from my VB6 dll (actually an Outlook plugin), LinkClicked fails to return the hidden text.  I have tried many things with no success - and I do not understand why the behaviour should be different when the window is called from VB6.  If I unhide the text, everything works properly - but this is not something I can do; the text absolutely has to be hidden.

Any ideas?

If I could subclass the .Net RTB and trap the EN_LINK notification, then I'm sure that I could resolve the issue.  However, I do not know if this is possible without a lot of effort - as to subclass (as far as I am aware), I would need to inherit my custom RTB from System.Windows.Forms.NativeWindow, which would mean I'd have to rewrite pretty much the entire RTB code.  Not something I want to do!
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Mike TomlinsonHigh School Computer Science, Computer Applications, Digital Design, and Mathematics Teacher
Top Expert 2009

Commented:
*Never used CFE_LINK or CFE_HIDDEN before.

A common mistake when dealing with both VB.Net and VB6 is using the wrong data type.  An "Integer" in .Net would be a "Long" in VB6.  Are you sure you have the CHARFORMAT2 structure declared properly on the VB6 side?

You can subclass a control by simply Inheriting from the control itself (not NativeWindow).  This means you get all the base functionality built-in:

    Public Class MyRTB
        Inherits RichTextBox

        Private Sub MyRTB_LinkClicked(ByVal sender As Object, ByVal e As System.Windows.Forms.LinkClickedEventArgs) Handles Me.LinkClicked
            Debug.Print("LinkeClicked() within MyRTB: " & e.LinkText)
            ' ... gather all the information and raise a CUSTOM event to pass it out ...
        End Sub
 
    End Class

Trapping a specific message can usually be done with WndProc():

    Public Class MyRTB
        Inherits RichTextBox

        Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
            Select Case m.Msg
                Case SOME_MESSAGE_HERE
                    Debug.Print("SOME_MESSAGE_HERE")

            End Select

            MyBase.WndProc(m)
        End Sub

    End Class

Author

Commented:
It definitely isn't a problem with declarations.  While the calling app is VB6, all it actually does is display the window - nothing is passed to it, and all the declarations are in .Net.  The test .Net app I have (which does the same thing, but from a small .Net app) works fine, which is the really odd thing.

I did try subclassing RichTextBox directly, as currently my modifed control does inherit it.  However, overriding LinkClicked doesn't help (the event passed is the same as I am trapping anyway), and when I implemented WndProc (which is what I need to do), it simply wasn't called... Have you successfully subclassed with WndProc in a RichTextBox this way?
Mike TomlinsonHigh School Computer Science, Computer Applications, Digital Design, and Mathematics Teacher
Top Expert 2009

Commented:
I've successfully used WndProc() with an RTB but as with all .Net controls it seems that some messages don't make it to WndProc().

You say you've gotten it to work in an all .Net app.  Can you show me the code that successfully grabs the hidden text?...and is that happening in the custom control or the test form?

Author

Commented:
Just double-checked WndProc, and it definitely doesn't work.  For reference, the code I am using is below.  I don't get any debug messages...

Public Class RichTextBoxLinks
        Inherits System.Windows.Forms.RichTextBox

        Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
            Debug.Print("WndProc hit")
            MyBase.WndProc(m)
        End Sub

Open in new window

Author

Commented:
Ok, the entire code is included below.  It currently includes the WndProc that is not working.

Using this class in a simple .Net app, the LinkClicked event automatically has the hidden text included (as you can see, it is actually part of the link).  This isn't included when called via the VB app.

The only thing that did cross my mind was if .Net when called from VB was using an earlier version of the RichEdit control that either didn't support hidden text, or didn't send it in the event.  However, according to the documentation, it should be supported from version 2 of the control, so this shouldn't be the issue.

Imports System
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices

Namespace RichTextBoxLinks
    Public Class RichTextBoxLinks
        Inherits System.Windows.Forms.RichTextBox

#Region "Interop-Defines"
        <StructLayout(LayoutKind.Sequential)> _
        Private Structure CHARFORMAT2_STRUCT
            Public cbSize As UInt32
            Public dwMask As UInt32
            Public dwEffects As UInt32
            Public yHeight As Int32
            Public yOffset As Int32
            Public crTextColor As Int32
            Public bCharSet As Byte
            Public bPitchAndFamily As Byte
            <MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> _
            Public szFaceName As Char()
            Public wWeight As UInt16
            Public sSpacing As UInt16
            Public crBackColor As Integer
            ' Color.ToArgb() -> int
            Public lcid As Integer
            Public dwReserved As Integer
            Public sStyle As Int16
            Public wKerning As Int16
            Public bUnderlineType As Byte
            Public bAnimation As Byte
            Public bRevAuthor As Byte
            Public bReserved1 As Byte
        End Structure

        <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
        Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
        End Function

        Private Const WM_USER As Integer = &H400
        Private Const WM_NOTIFY As Integer = &H4E
        Private Const EM_GETCHARFORMAT As Integer = WM_USER + 58
        Private Const EM_SETCHARFORMAT As Integer = WM_USER + 68

        Private Const SCF_SELECTION As Integer = &H1
        Private Const SCF_WORD As Integer = &H2
        Private Const SCF_ALL As Integer = &H4

#Region "CHARFORMAT2 Flags"
        Private Const CFE_BOLD As UInt32 = &H1
        Private Const CFE_ITALIC As UInt32 = &H2
        Private Const CFE_UNDERLINE As UInt32 = &H4
        Private Const CFE_STRIKEOUT As UInt32 = &H8
        Private Const CFE_PROTECTED As UInt32 = &H10
        Private Const CFE_LINK As UInt32 = &H20
        Private Const CFE_AUTOCOLOR As UInt32 = &H40000000
        Private Const CFE_SUBSCRIPT As UInt32 = &H10000
        ' Superscript and subscript are 
        Private Const CFE_SUPERSCRIPT As UInt32 = &H20000
        ' mutually exclusive 

        Private Const CFM_SMALLCAPS As Integer = &H40
        ' (*) 
        Private Const CFM_ALLCAPS As Integer = &H80
        ' Displayed by 3.0 
        Private Const CFM_HIDDEN As Integer = &H100
        ' Hidden by 3.0 
        Private Const CFM_OUTLINE As Integer = &H200
        ' (*) 
        Private Const CFM_SHADOW As Integer = &H400
        ' (*) 
        Private Const CFM_EMBOSS As Integer = &H800
        ' (*) 
        Private Const CFM_IMPRINT As Integer = &H1000
        ' (*) 
        Private Const CFM_DISABLED As Integer = &H2000
        Private Const CFM_REVISED As Integer = &H4000

        Private Const CFM_BACKCOLOR As Integer = &H4000000
        Private Const CFM_LCID As Integer = &H2000000
        Private Const CFM_UNDERLINETYPE As Integer = &H800000
        ' Many displayed by 3.0 
        Private Const CFM_WEIGHT As Integer = &H400000
        Private Const CFM_SPACING As Integer = &H200000
        ' Displayed by 3.0 
        Private Const CFM_KERNING As Integer = &H100000
        ' (*) 
        Private Const CFM_STYLE As Integer = &H80000
        ' (*) 
        Private Const CFM_ANIMATION As Integer = &H40000
        ' (*) 
        Private Const CFM_REVAUTHOR As Integer = &H8000


        Private Const CFM_BOLD As UInt32 = &H1
        Private Const CFM_ITALIC As UInt32 = &H2
        Private Const CFM_UNDERLINE As UInt32 = &H4
        Private Const CFM_STRIKEOUT As UInt32 = &H8
        Private Const CFM_PROTECTED As UInt32 = &H10
        Private Const CFM_LINK As UInt32 = &H20
        Private Const CFM_SIZE As UInt32 = &H8000000
        Private Const CFM_COLOR As UInt32 = &H40000000
        Private Const CFM_FACE As UInt32 = &H20000000
        Private Const CFM_OFFSET As UInt32 = &H10000000
        Private Const CFM_CHARSET As UInt32 = &H8000000
        Private Const CFM_SUBSCRIPT As UInt32 = CFE_SUBSCRIPT Or CFE_SUPERSCRIPT
        Private Const CFM_SUPERSCRIPT As UInt32 = CFM_SUBSCRIPT

        Private Const CFU_UNDERLINENONE As Byte = &H0
        Private Const CFU_UNDERLINE As Byte = &H1
        Private Const CFU_UNDERLINEWORD As Byte = &H2
        ' (*) displayed as ordinary underline 
        Private Const CFU_UNDERLINEDOUBLE As Byte = &H3
        ' (*) displayed as ordinary underline 
        Private Const CFU_UNDERLINEDOTTED As Byte = &H4
        Private Const CFU_UNDERLINEDASH As Byte = &H5
        Private Const CFU_UNDERLINEDASHDOT As Byte = &H6
        Private Const CFU_UNDERLINEDASHDOTDOT As Byte = &H7
        Private Const CFU_UNDERLINEWAVE As Byte = &H8
        Private Const CFU_UNDERLINETHICK As Byte = &H9
        Private Const CFU_UNDERLINEHAIRLINE As Byte = &HA
        ' (*) displayed as ordinary underline 

#End Region

#End Region


        Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
            Debug.Print("WndProc hit")
            MyBase.WndProc(m)
        End Sub


        Public Sub New()
            Me.DetectUrls = False
        End Sub

        <DefaultValue(False)> _
        Public Shadows Property DetectUrls() As Boolean
            Get
                Return MyBase.DetectUrls
            End Get
            Set(ByVal value As Boolean)
                MyBase.DetectUrls = value
            End Set
        End Property

        Public Sub InsertLink(ByVal text As String)
            Dim position As Integer
            Try
                position = Me.SelectionStart
            Catch ex As Exception
                position = Me.Text.Length - 1
            End Try
            Try
                InsertLink(text, position)
            Catch ex As Exception
            End Try
        End Sub

        Public Sub InsertLink(ByVal text As String, ByVal position As Integer)
            Try
                If position < 0 Then position = 0
                If position > Me.TextLength Then position = Me.TextLength
                Me.SelectionStart = position
                Me.SelectedText = text
                Me.[Select](position, text.Length)
                Me.SetSelectionLink(True)
                Me.[Select](position + text.Length, 0)
            Catch ex As Exception
                MsgBox(ex.Message, MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "InsertLink1")
            End Try
        End Sub

        Public Sub InsertLink(ByVal text As String, ByVal hyperlink As String)
            Dim position As Integer
            Try
                position = Me.SelectionStart
            Catch ex As Exception
                MsgBox(ex.Message, MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "InsertLink2")
                position = Me.TextLength
            End Try
            Try
                If position > Me.TextLength Then position = Me.TextLength
                InsertLink(text, hyperlink, position)
            Catch ex As Exception
                MsgBox(ex.Message, MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "InsertLink2")
            End Try
        End Sub

        Private Function EscapeRTF(ByVal sText As String) As String
            sText = sText.Replace("\", "\\")
            sText = sText.Replace("{", "\{")
            sText = sText.Replace("}", "\}")
            Return sText
        End Function

        Public Sub InsertLink(ByVal text As String, ByVal hyperlink As String, ByVal position As Integer)
            Dim hLength As Integer
            Dim tLength As Integer
            If position < 0 OrElse position > Me.TextLength Then
                Throw New ArgumentOutOfRangeException("position=" & position.ToString & ", length=" & Me.Text.Length)
            End If

            Try
                hLength = hyperlink.Length
                tLength = text.Length
                'hyperlink = EscapeRTF(hyperlink)
                'text = EscapeRTF(text)
                Me.SelectionStart = position
                'Me.SelectedRtf = ("{\rtf1\ansi " & text & "\v#") & hyperlink & "\v0 }"
                Me.SelectedText = text & "#" & hyperlink
                Me.[Select](position, tLength + hLength + 1)
                Me.SetSelectionLink(True)
                Me.[Select](position + tLength, hLength + 1)
                'SetSelectionSize(10000)
                SetSelectionStyle(CFM_HIDDEN, CFM_HIDDEN)
                Me.[Select](position + tLength + hLength + 1, 0)
            Catch ex As Exception
                MsgBox(ex.Message, MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "InsertLink3")
            End Try
        End Sub

        Public Sub SetSelectionLink(ByVal link As Boolean)
            SetSelectionStyle(CFM_LINK, IIf(link, CFE_LINK, 0))
        End Sub

        Public Function GetSelectionLink() As Integer
            Return GetSelectionStyle(CFM_LINK, CFE_LINK)
        End Function


        Private Sub SetSelectionStyle(ByVal mask As UInt32, ByVal effect As UInt32)
            Dim cf As New CHARFORMAT2_STRUCT()
            cf.cbSize = Convert.ToUInt32(Marshal.SizeOf(cf))
            cf.dwMask = mask
            cf.dwEffects = effect

            Dim wpar As New IntPtr(SCF_SELECTION)
            Dim lpar As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
            Marshal.StructureToPtr(cf, lpar, False)

            Dim res As IntPtr = SendMessage(Handle, EM_SETCHARFORMAT, wpar, lpar)

            Marshal.FreeCoTaskMem(lpar)
        End Sub


        Private Sub SetSelectionSize(ByVal size As Long)
            Dim cf As New CHARFORMAT2_STRUCT()
            cf.cbSize = Convert.ToUInt32(Marshal.SizeOf(cf))
            cf.dwMask = CFM_SIZE
            cf.dwEffects = 0
            cf.yHeight = size

            Dim wpar As New IntPtr(SCF_SELECTION)
            Dim lpar As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
            Marshal.StructureToPtr(cf, lpar, False)

            Dim res As IntPtr = SendMessage(Handle, EM_SETCHARFORMAT, wpar, lpar)

            Marshal.FreeCoTaskMem(lpar)
        End Sub

        Private Function GetSelectionStyle(ByVal mask As UInt32, ByVal effect As UInt32) As Integer
            Dim cf As New CHARFORMAT2_STRUCT()
            cf.cbSize = Convert.ToUInt32(Marshal.SizeOf(cf))
            cf.szFaceName = New Char(31) {}

            Dim wpar As New IntPtr(SCF_SELECTION)
            Dim lpar As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
            Marshal.StructureToPtr(cf, lpar, False)

            Dim res As IntPtr = SendMessage(Handle, EM_GETCHARFORMAT, wpar, lpar)

            cf = DirectCast(Marshal.PtrToStructure(lpar, GetType(CHARFORMAT2_STRUCT)), CHARFORMAT2_STRUCT)

            Dim state As Integer
            If (cf.dwMask And mask) = mask Then
                If (cf.dwEffects And effect) = effect Then
                    state = 1
                Else
                    state = 0
                End If
            Else
                state = -1
            End If

            Marshal.FreeCoTaskMem(lpar)
            Return state
        End Function

        Private Sub RichTextBoxLinks_LinkClicked(ByVal sender As Object, ByVal e As System.Windows.Forms.LinkClickedEventArgs) Handles Me.LinkClicked

        End Sub
    End Class
End Namespace

Open in new window

Author

Commented:
It's impractical to post the code I am using to create the linked text (the project is large, and also there are large parts of it that I can't post on a public forum) - however, the function below is the one used to translate text with hyperlinks (I use HTML hyperlinks) and write them to the RTB.

Private Sub UpdateLinkText(ByVal sText As String)
        ' Need to go through text and replace any links
        Dim i As Integer
        Dim sLink As String
        Dim sLinkText As String
        Dim sATag As String
        Dim oMatches As System.Text.RegularExpressions.MatchCollection

        RichTextBoxLinks1.Clear()
        While sText.Length > 0
            i = sText.IndexOf("<a href", 0, StringComparison.OrdinalIgnoreCase)
            If i < 0 Then
                RichTextBoxLinks1.AppendText(sText)
                Exit While
            End If
            RichTextBoxLinks1.AppendText(sText.Substring(0, i))
            sText = sText.Substring(i)
            i = sText.IndexOf("</a>", 0, StringComparison.OrdinalIgnoreCase)
            sATag = sText.Substring(0, i + 4)
            oMatches = System.Text.RegularExpressions.Regex.Matches(sATag, "<a href=""([^""]*)"">(.*)</a>")
            If oMatches.Count = 1 Then
                If oMatches.Item(0).Groups.Count = 3 Then
                    sLink = oMatches.Item(0).Groups(1).ToString
                    sLinkText = oMatches.Item(0).Groups(2).ToString
                    RichTextBoxLinks1.InsertLink(sLinkText, sLink)
                Else
                    MsgBox(oMatches.Item(0).Groups.Count.ToString)
                End If
            End If
            If (i + 4) > sText.Length Then
                sText = ""
            Else
                sText = sText.Substring(i + 4)
            End If
        End While

    End Sub

Open in new window

High School Computer Science, Computer Applications, Digital Design, and Mathematics Teacher
Top Expert 2009
Commented:
I got it to work just fine with WndProc()...though I didn't get EM_LINK which is broadcast to the PARENT control.

Here is what I saw when a link was clicked:

msg=0x201 (WM_LBUTTONDOWN) hwnd=0xa05e8 wparam=0x1 lparam=0xc0056 result=0x0
msg=0x204e (WM_REFLECT + WM_NOTIFY) hwnd=0xa05e8 wparam=0xa05e8 lparam=0x559dcdc result=0x0
msg=0x204e (WM_REFLECT + WM_NOTIFY) hwnd=0xa05e8 wparam=0xa05e8 lparam=0x559daa0 result=0x0
msg=0x44a (EM_STREAMOUT) hwnd=0xa05e8 wparam=0x11 lparam=0x559d01c result=0x0
msg=0x44b (EM_GETTEXTRANGE) hwnd=0xa05e8 wparam=0x0 lparam=0x559d07c result=0x0
msg=0x202 (WM_LBUTTONUP) hwnd=0xa05e8 wparam=0x0 lparam=0xc0056 result=0x0

My code was simply:
(I hit "Build" and "MyRTB" appeared at the top of the ToolBox then I dropped one onto the Form and ran it.)
Public Class Form1

End Class

Public Class MyRTB
    Inherits RichTextBox

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Debug.Print(m.ToString)

        MyBase.WndProc(m)
    End Sub

End Class

Open in new window

Author

Commented:
Ok, this is rather odd.

Tried again, but put a breakpoint on the MyBase.WndProc(m) line.  The subroutine is definitely getting called, but no output is being sent to the immediate window...  I feel a small step forward has been made (this has probably been the case all along as far as WndProc is concerned, but foolishly I assumed that debug.print would work...)

Author

Commented:
Oh dear... thinking about it, it's isn't odd at all.

My RTB is in a dll.  My test .Net app is a command-line app.  Debug.Print will not work for the immediate window in the dll, as it is actually the command-line app that is running.  Breakpoints work, but no code-editing does in the dll.

Author

Commented:
Definitely a step forward.  I can successfully trap EM_GETTEXTRANGE in both environments.  So I think I just need to ensure that I can return the same text each time...  Strangely, I can't see any difference in the calls in either environment, so quite why the LinkClicked event is returning different values is still a mystery.
Mike TomlinsonHigh School Computer Science, Computer Applications, Digital Design, and Mathematics Teacher
Top Expert 2009

Commented:
...yeah, there is a way to attach the IDE to a process but I've never tried it myself:
http://msdn.microsoft.com/en-us/library/0bxe8ytt.aspx

You may want to develop with the Inherited RichTextBox directly in the Project just to make it easier.

Author

Commented:
Well, it looks like the difference is in the EM_STREAMOUT, which will cause complications.  I've trapped EM_GETTEXTRANGE, and in the test app the range being asked for is longer than in the deployed app (basically, hidden text is ignored).

I am hopeful that I may be able to get the info I need by trapping the WM_LBUTTONDOWN and WM_LBUTTONUP events with a lookup for the actual hyperlinks (created when they are inserted).

Author

Commented:
Thanks.  While the reason why LinkClicked doesn't return hidden text when called from a VB6 dll is still a mystery, I have now implemented the custom control by directly responding to mouse events and returning the data I needed.  This was made much simpler by this answer, as it detailed the messages created by LinkClicked.