如何解决在VB.NET中获取WPF RichTextBox Bullet List中的选择类型
在发现有一种方法可以在 VB.NET 中更改 WPF RichTextBox Bullet List ListMarker 样式后，我遇到了涉及部分选择的问题。
以下代码可以更改 WPF 富文本框上的项目符号类型：
Private Sub BulletList(intType As Integer)
With rtfActiveEdit
' Tries to avoid crashing...
Try
' Only operates if there's something selected...
If Not IsNothing(.Selection.Start.Paragraph) And Not IsNothing(.Selection.End.Paragraph) Then
' Sets up data processing variables...
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
' Obtains the highlighted material...
strList = Split(strSelect,strBreak)
' Counts up items in the highlighted material...
intCount = strList.Length
' Sets up the bullet point style...
Dim nowStyle As TextMarkerStyle
Dim tmStyle As TextMarkerStyle
' Responds based on user input...
Select Case intType
Case 0 ' NONE
tmStyle = TextMarkerStyle.None
Case 1 ' DISC (Default)
tmStyle = TextMarkerStyle.Disc
Case 2 ' BOX
tmStyle = TextMarkerStyle.Box
Case 3 ' CIRCLE
tmStyle = TextMarkerStyle.Circle
Case 4 ' SQUARE
tmStyle = TextMarkerStyle.Square
Case 5 ' DECIMAL NUMBERS
tmStyle = TextMarkerStyle.Decimal
Case 6 ' LOWERCASE
tmStyle = TextMarkerStyle.LowerLatin
Case 7 ' UPPERCASE
tmStyle = TextMarkerStyle.UpperLatin
Case 8 ' LOWERCASE ROMAN
tmStyle = TextMarkerStyle.LowerRoman
Case 9 ' UPPERCASE ROMAN
tmStyle = TextMarkerStyle.UpperRoman
End Select
' Reacts based on whether selected contents include a list...
If phStart.Parent.GetType() Is GetType(ListItem) And phEnd.Parent.GetType() Is GetType(ListItem) Then
' Loads the current list type...
nowStyle = CType(phStart.Parent,ListItem).List.MarkerStyle
' Responds based on the list type...
Select Case nowStyle.ToString
Case "Disc","Box","Circle","Square"
' Removes BULLET LIST formatting
EditingCommands.ToggleBullets.Execute(vbNull,rtfActiveEdit)
Case "Decimal","LowerLatin","UpperLatin","LowerRoman","UpperRoman"
' Removes ORDERED LIST formatting...
EditingCommands.ToggleNumbering.Execute(vbNull,rtfActiveEdit)
Case Else
' Should NEVER happen...
End Select
' Triggers list reprocessing...
blnList = True
' Only triggers complete list removal if the user chooses...
If intType = 0 Then
' Triggers list removal...
blnPlain = True
End If
Else
' Only triggers complete list blockage if the user chooses "None" on a NON-LIST...
If intType = 0 Then
' Prevents reformatting "NONE" as a list (YIKES!!!)...
blnPlain = True
Beep()
End If
End If
' Only operates if the list needs formatting...
If blnPlain = False Then
' Prepares to add items to the new list...
lstOutput = New List
' Sets the style for the list...
lstOutput.MarkerStyle = tmStyle
' Loops through the selected text...
For intItem = 0 To intCount - 1
' Collects the item from the array...
strPickup = strList(intItem)
' Removes unwanted list markers that survived formatting removal...
If blnList = True Then
' Strips unwanted formatting...
strPickup = Right(strList(intItem),Len(strList(intItem)) - InStr(strList(intItem),strTab))
' Only strips off leading tab characters...
While Strings.Left(strPickup,1) = strTab
' Removes the tab...
strPickup = Right(strPickup,Len(strPickup) - 1)
End While
End If
' Creates a new paragraph...
phHold = New Paragraph
' Adds text to the paragraph...
phHold.Inlines.Add(strPickup)
' Adds the paragraph to a new list item...
itmAdd = New ListItem(phHold)
' Adds the new list item to the new list...
lstOutput.ListItems.Add(itmAdd)
Next
' Attempts to resolve how to handle the selection...
Dim objPlace As Type
' Attempts to get the element just before this one...
objPlace = .Selection.GetType
' Operates based on whether the item just before the selection is a list item...
If objPlace Is GetType(List) Then
MsgBox("This is the part that needs to be changed...")
' needs to select the affected list item
' list item needs to get a new paragraph
' new paragraph needs to get a new list
' new list needs to be the output
Else
MsgBox("This part only works on fully selected lists")
' Clears the selection (YIKES!!!)...
.Selection.Text = ""
' Attempts to clear a leading carriage return from the list (YIKES!!!)...
.Document.Blocks.Remove(.CaretPosition.Paragraph)
' This step constistently fails when part of a list is selected...
' REWRITE IT TO FIX THE PROBLEM
' Inserts the list directly into the document...
.Document.Blocks.InsertBefore(.CaretPosition.Paragraph,lstOutput)
End If
End If
End If
Catch ex As Exception
' Notifies the user...
MsgBox("Try selecting something simpler." & vbCrLf & ex.Message,vbExclamation,"Formatting Failed")
End Try
End With
End Sub
此代码由一个菜单激活，该菜单为不同的项目符号样式分配了一个值。当用户从菜单中选择一种样式时，按钮会发送适当的值。
我试图确定选择类型是什么，试图根据链接中的内容强制嵌套项目符号列表或编号列表的部分选择部分。但我得到的最好的是带有当前代码的“System.Runtime.Type”。较早的配置可以获得与选择相邻的元素，但唯一提供的类型是“运行”。如果系统可以识别出该选择具有“ListItem”，则可以从那里继续。
Creating Nested Bullet List At Runtime 是可能的，这涉及在包含在文档中之后添加到列表中。
如果我的程序可以识别被选择元素的类型，它可以被编程为分支和处理部分选择。
解决方法
事实证明，获取父对象需要 iterating through the type of object by moving the text pointer。
' Attempts to resolve how to handle the selection...
Dim objPlace As DependencyObject
' Identifies the caret position to begin the loop...
Dim tpPlace As TextPointer = .CaretPosition
' Gets the first object type...
objPlace = .CaretPosition.GetAdjacentElement(LogicalDirection.Backward)
' Sets up a feedback variable that's easier to read or translate...
Dim strPlace As String = ""
Dim intPlace As Integer = 0
' Attempts to loop through parent objects...
Do While Not (objPlace.GetType Is GetType(List))
' Increments the counter...
intPlace += 1
' Moves the text pointer one unit farther over...
tpPlace = tpPlace.GetNextContextPosition(LogicalDirection.Backward)
' Gets the object...
objPlace = tpPlace.GetAdjacentElement(LogicalDirection.Backward)
' Exits the loop if it runs too long,or if nothing is found...
If intPlace < 1000 And Not IsNothing(objPlace) Then
' Gets the object type...
strPlace = objPlace.GetType.ToString
Else
' Exits the loop...
Exit Do
End If
Loop
上面的代码标识对象类型，然后创建一个文本指针，如果当前对象不匹配，程序可以移动该指针以查找所需的对象类型。它会越来越早地移动文本指针，直到找到可以使用的内容。条件通过计算已运行的循环数来限制代码无休止地运行。
编辑： 如果 objPlace 什么都没有，则修改循环以允许程序中止。这可以防止在文本指针到达文档开头时崩溃，因为在那里无法找到相邻元素。
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
