使DHTMLEd控件的代码将直引号替换为卷曲引号

时间:2020-03-05 18:53:03  来源:igfitidea点击:

我有一个旧的,遗留的VB6应用程序,该应用程序使用DHTML编辑控件作为HTML编辑器。 Microsoft DHTML编辑控件(也称为DHTMLEd)可能只不过是内部使用IE自身的本机编辑功能的IE控件。

我想修改应用程序以实现像Word这样的智能引号。具体来说,""将被替换为或者,而""将被替换为或者根据键入的情况进行适当的替换;并且如果用户在替换后立即按Ctrl + Z,则将其恢复为直接引号。

有人有这样做的代码吗?

如果我们没有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解决方案

编辑:如果目标是Windows Vista,请不要忘记包含可重新分发的DHTML编辑控件。