VB.NET下WPF RichTextBox项目符号列表选中类型识别及部分选中处理问题

掌握VB.NET中修改WPF RichTextBox项目符号列表ListMarker样式的方法后，遇到了部分选中内容处理的问题。

现有功能实现代码 #

Private Sub BulletList(intType As Integer)
    With rtfActiveEdit
        ' 避免程序崩溃
        Try
            ' 仅在有选中内容时执行操作
            If Not IsNothing(.Selection.Start.Paragraph) And Not IsNothing(.Selection.End.Paragraph) Then
                ' 初始化处理变量
                Dim phStart As Block = .Selection.Start.Paragraph
                Dim phEnd As Block = .Selection.End.Paragraph
                Dim strSelect As String = .Selection.Text
                Dim strList() As String
                Dim lstOutput As List
                Dim itmAdd As ListItem
                Dim strPickup As String = ""
                Dim phHold As Paragraph
                Dim intItem As Integer = 0
                Dim intCount As Integer = 0
                Dim strBreak As String = vbCrLf
                Dim strTab As String = vbTab
                Dim blnList As Boolean = False
                Dim blnPlain As Boolean = False
                ' 获取选中内容
                strList = Split(strSelect, strBreak)
                intCount = strList.Length
                ' 定义项目符号样式
                Dim nowStyle As TextMarkerStyle
                Dim tmStyle As TextMarkerStyle
                ' 根据用户传入参数匹配样式
                Select Case intType
                    Case 0  ' 无样式
                        tmStyle = TextMarkerStyle.None
                    Case 1  ' 实心圆点（默认）
                        tmStyle = TextMarkerStyle.Disc
                    Case 2  ' 方块
                        tmStyle = TextMarkerStyle.Box
                    Case 3  ' 空心圆
                        tmStyle = TextMarkerStyle.Circle
                    Case 4  ' 实心方块
                        tmStyle = TextMarkerStyle.Square
                    Case 5  ' 阿拉伯数字
                        tmStyle = TextMarkerStyle.Decimal
                    Case 6  ' 小写字母
                        tmStyle = TextMarkerStyle.LowerLatin
                    Case 7  ' 大写字母
                        tmStyle = TextMarkerStyle.UpperLatin
                    Case 8  ' 小写罗马数字
                        tmStyle = TextMarkerStyle.LowerRoman
                    Case 9  ' 大写罗马数字
                        tmStyle = TextMarkerStyle.UpperRoman
                End Select
                ' 判断选中内容是否包含列表
                If phStart.Parent.GetType() Is GetType(ListItem) And phEnd.Parent.GetType() Is GetType(ListItem) Then
                    ' 获取当前列表样式
                    nowStyle = CType(phStart.Parent, ListItem).List.MarkerStyle
                    ' 移除原有列表格式
                    Select Case nowStyle.ToString
                        Case "Disc", "Box", "Circle", "Square"
                            ' 移除项目符号列表格式
                            EditingCommands.ToggleBullets.Execute(vbNull, rtfActiveEdit)
                        Case "Decimal", "LowerLatin", "UpperLatin", "LowerRoman", "UpperRoman"
                            ' 移除编号列表格式
                            EditingCommands.ToggleNumbering.Execute(vbNull, rtfActiveEdit)
                        Case Else
                            ' 异常分支，理论上不会触发
                    End Select
                    blnList = True
                    ' 用户选择无样式时直接移除列表
                    If intType = 0 Then
                        blnPlain = True
                    End If
                Else
                    ' 非列表内容选择无样式时不做格式化处理
                    If intType = 0 Then
                        blnPlain = True
                        Beep()
                    End If
                End If

                ' 需要格式化列表时执行操作
                If blnPlain = False Then
                    lstOutput = New List
                    lstOutput.MarkerStyle = tmStyle
                    ' 遍历选中内容生成新列表
                    For intItem = 0 To intCount - 1
                        strPickup = strList(intItem)
                        ' 移除原有列表残留的标记符号
                        If blnList = True Then
                            strPickup = Right(strList(intItem), Len(strList(intItem)) - InStr(strList(intItem), strTab))
                            ' 移除开头多余的制表符
                            While Strings.Left(strPickup, 1) = strTab
                                strPickup = Right(strPickup, Len(strPickup) - 1)
                            End While
                        End If
                        ' 生成新段落和列表项
                        phHold = New Paragraph
                        phHold.Inlines.Add(strPickup)
                        itmAdd = New ListItem(phHold)
                        lstOutput.ListItems.Add(itmAdd)
                    Next

                    ' 处理选中内容插入逻辑
                    Dim objPlace As Type
                    objPlace = .Selection.GetType
                    ' 判断选中内容是否为列表
                    If objPlace Is GetType(List) Then
                        MsgBox("该部分逻辑待修改")
                        ' 需要选中受影响的列表项
                        ' 为列表项新增段落
                        ' 为新段落新增列表
                        ' 将生成的新列表作为输出插入
                    Else
                        MsgBox("当前逻辑仅支持全选列表的格式化")
                        ' 清空选中内容
                        .Selection.Text = ""
                        ' 移除列表前多余的换行
                        .Document.Blocks.Remove(.CaretPosition.Paragraph)
                        ' 部分选中列表时该步骤会执行失败，需要重写
                        ' 将新列表插入文档
                        .Document.Blocks.InsertBefore(.CaretPosition.Paragraph, lstOutput)
                    End If
                End If
            End If
        Catch ex As Exception
            MsgBox("请选择更简单的内容重试。" & vbCrLf & ex.Message, vbExclamation, "格式化失败")
        End Try
    End With
End Sub

实现逻辑说明 #

• 代码由绑定了不同项目符号样式值的菜单触发，用户选择对应样式后，按钮会传入匹配的intType参数执行格式化
• 当前已支持全选列表场景下的样式切换、列表格式移除功能

待解决问题 #

• 尝试判断选中内容类型以处理部分选中列表的嵌套场景时，无法正确识别选中元素的实际类型：当前代码最多只能获取到System.Runtime.Type类型，更早的配置版本仅能返回Run类型的相邻元素
• 若可识别选中内容包含ListItem，即可实现分支逻辑处理部分选中的场景
• 现有代码在部分选中列表时，删除选中内容、插入新列表的步骤会执行失败

内容的提问来源于stack exchange，提问作者user20568