Public Class ctlPhonesParser

    Private Const RX_FULLPHONE As String = "[\d\s\-\(\)\+]{5,}"
    Private Const RX_SHORTPHONE As String = "0\d{3}"
    Private Const RX_INTPHONE As String = "[1-4]\d\d"

    Private Sub ctlPhonesParser_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
        If Not Me.DataContext Is Nothing Then
            Dim tb As New TextBlock, mm As MatchCollection, pm As Match
            Dim sparts() As String = Split(Me.DataContext, ",")
            tb.TextWrapping = TextWrapping.Wrap
            tb.FontSize = 12
            For x As Integer = 0 To sparts.Length - 1
                Dim s As String = Trim(sparts(x))

                If Regex.IsMatch(s, RX_FULLPHONE) Then
                    mm = Regex.Matches(s, RX_FULLPHONE)
                ElseIf Regex.IsMatch(s, RX_SHORTPHONE) Then
                    mm = Regex.Matches(s, RX_SHORTPHONE)
                ElseIf Regex.IsMatch(s, RX_INTPHONE) Then
                    mm = Regex.Matches(s, RX_INTPHONE)
                Else
                    mm = Nothing
                End If
                If mm Is Nothing Then
                    tb.Inlines.Add(New Run(s))
                Else
                    pm = Nothing
                    For Each m As Match In mm
                        If pm Is Nothing Then
                            If m.Index > 0 Then tb.Inlines.Add(New Run(Mid(s, 1, m.Index)))
                        ElseIf pm.Index + pm.Length + 1 < m.Index Then
                            tb.Inlines.Add(New Run(Mid(s, pm.Index + pm.Length + 1, m.Index - pm.Index - pm.Length)))
                        End If
                        tb.Inlines.Add(CreateHyper(m.Value))
                        pm = m
                    Next
                    If pm.Index + pm.Length < Len(s) Then tb.Inlines.Add(New Run(Mid(s, pm.Index + pm.Length + 1)))
                End If
                If sparts.Length > 1 And x <> sparts.Length - 1 Then tb.Inlines.Add(New Run(", "))
            Next
            Me.Content = tb
        End If
    End Sub

    Private Function CreateHyper(sText As String) As Hyperlink
        Dim nf As String = sText
        NormalizePhone(nf)
        Dim hl As New Hyperlink(New Run(sText)) With {.ToolTip = "Набрать номер " & nf, .Tag = nf}
        AddHandler hl.Click, AddressOf Me.HLClick
        Return hl
    End Function

    Private Sub HLClick(sender As Hyperlink, e As RoutedEventArgs)
        g_ctlMain.txtPhone.Text = CType(sender.Inlines.FirstInline, Run).Text
        Dim dc As Contact = FindDataContext(Of Contact)(Me)
        If dc Is Nothing Then
            DialNumber(New LastDialed With {.Phone = sender.Tag})
        Else
            DialNumber(New LastDialed With {.Phone = sender.Tag, .Name = dc.Name}) '<-- возникла нужда добавить в список последних набранных номеров не только номер, но и имя контакта
        End If
    End Sub
End Class