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

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

注意：此解决方案在撤销链中插入一个附加级别.例如,键入“这是一个测试”给出了一个“这是一个测试” – > “这是一个测试” – >“这是一个测试 – >” – >“(额外的粗体).要删除这个额外的级别,你必须实现某种Postmessage子类化解决方案,它不涉及取消本机按键

编辑：如果您定位到Windows Vista,请不要忘记包含DHTML Editing Control redistributable.