使 DHTMLEd 控件用弯引号替换直引号的代码

2022-01-20 00:00:00 dom html vb6

我有一个旧的、遗留的 VB6 应用程序,它使用 DHTML 编辑控件作为 HTML 编辑器.Microsoft DHTML 编辑控件,又名 DHTMLEd,可能只不过是一个在内部使用 IE 自己的本机编辑功能的 IE 控件.

I've got an old, legacy VB6 application that uses the DHTML editing control as an HTML editor. The Microsoft DHTML editing control, a.k.a. DHTMLEd, is probably nothing more than an IE control using IE's own native editing capability internally.

我想修改应用程序以实现 Word 等智能引号.具体来说," 被替换为 或 " 并且 ' 被替换为 '> 或 ' 视输入而定;如果用户在替换后立即按下 Ctrl+Z,它会恢复为直引号.

I'd like to modify the app to implement smart quotes like Word. Specifically, " is replaced with " or " and ' is replaced with ‘ or ’ as appropriate as it is typed; and if the user presses Ctrl+Z immediately after the replacement, it goes back to being a straight quote.

有人有这样的代码吗?

如果你没有 DHTML/VB6 的代码,但有在带有 contentEditable 区域的浏览器中工作的 JavaScript 代码,我也可以使用它

推荐答案

这是VB6版本:

Private Sub DHTMLEdit1_onkeypress()
    Dim e As Object
    Set e = DHTMLEdit1.DOM.parentWindow.event
    'Perform smart-quote replacement'
    Select Case e.keyCode
    Case 34: 'Double-Quote'
        e.keyCode = 0
        If IsAtWordEnd Then
            InsertDoubleUndo ChrW$(8221), ChrW$(34)
        Else
            InsertDoubleUndo ChrW$(8220), ChrW$(34)
        End If
    Case 39: 'Single-Quote'
        e.keyCode = 0
        If IsAtWordEnd Then
            InsertDoubleUndo ChrW$(8217), ChrW$(39)
        Else
            InsertDoubleUndo ChrW$(8216), ChrW$(39)
        End If
    End Select
End Sub

Private Function IsLetter(ByVal character As String) As Boolean
    IsLetter = UCase$(character) <> LCase$(character)
End Function

Private Sub InsertDoubleUndo(VisibleText As String, HiddenText As String)
    Dim selection As Object
    Set selection = DHTMLEdit1.DOM.selection.createRange()
    selection.Text = HiddenText
    selection.moveStart "character", -Len(HiddenText)
    selection.Text = VisibleText
End Sub

Private Function IsAtWordEnd() As Boolean

    Dim ch As String
    ch = PreviousChar
    IsAtWordEnd = (ch <> " ") And (ch <> "")

End Function

Private Function PreviousChar() As String

    Dim selection As Object
    Set selection = m_dom.selection.createRange()
    selection.moveStart "character", -1
    PreviousChar = selection.Text

End Function

注意:此解决方案在撤消链中插入了一个附加级别.例如,键入This is a test"会给出This is a test"->This is a test"-> This is a test -> ->"的链(额外水平粗体).要删除这个额外的级别,您必须实现某种不涉及取消本机按键的 PostMessage+subclassing 解决方案

Note: this solution inserts an additional level in the undo chain. For example, typing "This is a test" gives a chain of "This is a test" -> "This is a test" -> "This is a test -> " -> " (extra level in bold). To remove this extra level you'd have to implement some sort of PostMessage+subclassing solution that doesn't involve cancelling the native keypress

不要忘记包含 DHTML 编辑控件可再发行,如果您的目标是 Windows Vista.

edit: Don't forget to include the DHTML Editing Control redistributable if you are targeting Windows Vista.

相关文章