狐表cs集成富文本框KindEditor 完整解决方案,在前人基础上做整理和更新，支持word直接粘贴、截图直接粘贴、只读控制、纯文本提取、打印
发表日期:
2022-02-17
1效果
2KindEditor说明
2.1集成说明
基于之前版主等前人的帖子，重新整理代码，增加一些狐表特色功能：
1. 只读控制
2. 从html提取纯本文
3. 模仿狐表字段绑定功能，自动更新
4. 更新KindEditor到最新版本，修复了很多bug
5. 增加600毫秒的js防抖，连续填写字符时，延迟0.6秒才一次过回写狐表。防止每输入一个字符就触发一次内容回写狐表，严重消耗cpu性能
虽然它是bs领域的富文本框，但是巧妙利用System.Runtime.InteropServices+WebBrowser，使之不需要使用Http服务，普通开发版即可使用。
目前在win10、win7测试通过，都是原生系统，没升级过IE内核
我还试过.net自带的RichTextBox富文本框，但是发现有些问题，拷贝2m以上的图文进去，基本卡死崩溃了，然后也没有常用的字体、段落、颜色设置，感觉不太好用
感谢前人的经验分享：
2.2官方简介
简介：KindEditor 是一套开源的在线HTML编辑器，主要用于让用户在网站上获得所见即所得编辑效果，开发人员可以用 KindEditor 把传统的多行文本输入框(textarea)替换为可视化的富文本输入框。 KindEditor 使用 JavaScript 编写，可以无缝地与 Java、.NET、PHP、ASP 等程序集成，比较适合在 CMS、商城、论坛、博客、Wiki、电子邮件等互联网应用上使用。
主要特点
1. 快速：体积小，加载速度快
2. 开源：开放源代码，高水平，高品质
3. 底层：内置自定义 DOM 类库，精确操作 DOM
4. 扩展：基于插件的设计，所有功能都是插件，可根据需求增减功能
5. 风格：修改编辑器风格非常容易，只需修改一个 CSS 文件
6. 兼容：支持大部分主流浏览器，比如 IE、Firefox、Safari、Chrome、Opera
2.3本次使用版本
ver 4.1.11 (2016-03-31)，已经目前在官网找到的最新版本了，应该不会有后续更新，所有bug都修完了
3使用方法
3.1全局代码
'富文本框 WebBrowser里的KindEditor方法属性
<System.Runtime.InteropServices.ComVisibleAttribute(True)> _
Public Class KindEditor
Public isReadOnly As Boolean =False '是否只读
Private _FullHtmlBindingField As String
Private _InnerHtmlBindingField As String
Private _FullHtml As String
Private _InnerHtml As String
'完整html内容
Property FullHtml() As String
Get '获取属性的值
Return _FullHtml
End Get
Set(ByVal value As String) '设定属性的值
_FullHtml = value
'同步更新绑定的列
If _FullHtmlBindingField <> "" Then
Dim vs() As String = _FullHtmlBindingField.split(".")
If vs.Length =2 Then
Tables(vs(0)).Current(vs(1)) = value
End If
End If
End Set
End Property
'纯文本内容
Property InnerHtml() As String
Get '获取属性的值
Return _InnerHtml
End Get
Set(ByVal value As String) '设定属性的值
'1用正则表达式去掉所有空格和换行符
Static rgx As New RegularExpressions.Regex("\s")
value = rgx.Replace(value,"")
'2去掉base64的图片
Dim si As Integer = value.IndexOf("<imgsrc=""data:image/png;base64,")
If si>-1 Then
Dim ei As Integer = value.IndexOf("/>",si)
Do While (ei>si AndAlso si >-1)
value = value.Remove(si,ei-si+2)
si = value.IndexOf("<imgsrc=""data:image/png;base64,")
If si >-1 Then
ei = value.IndexOf("/>",si)
End If
Loop
End If
'3去掉第二种格式的base64的图片
si = value.IndexOf("<imgwidth=")
If si>-1 Then
Dim ei As Integer = value.IndexOf("/>",si)
Do While (ei>si AndAlso si >-1)
value = value.Remove(si,ei-si+2)
si = value.IndexOf("<imgwidth=")
If si >-1 Then
ei = value.IndexOf("/>",si)
End If
Loop
End If
_InnerHtml =value
'同步更新绑定的列
If _InnerHtmlBindingField <> "" Then
Dim vs() As String = _InnerHtmlBindingField.split(".")
If vs.Length =2 Then
Tables(vs(0)).Current(vs(1)) = value
End If
End If
End Set
End Property
'把html内容绑定到某个列
Property FullHtmlBindingField() As String
Get '获取属性的值
Return _FullHtmlBindingField
End Get
Set(ByVal value As String) '设定属性的值
'把当前列内容写入到FullHtml
If value <> "" Then
Dim vs() As String = value.split(".")
If vs.Length =2 Then
_FullHtml = Tables(vs(0)).Current(vs(1))
End If
End If
_FullHtmlBindingField= value
End Set
End Property
'把纯文本内容绑定到某个列
Property InnerHtmlBindingField() As String
Get '获取属性的值
Return _InnerHtmlBindingField
End Get
Set(ByVal value As String) '设定属性的值
'把当前列内容写入到InnerHtml
If value <> "" Then
Dim vs() As String = value.split(".")
If vs.Length =2 Then
_InnerHtml = Tables(vs(0)).Current(vs(1))
End If
End If
_InnerHtmlBindingField =value
End Set
End Property
End Class3.2初始化富文本框
自行添加好WebBrowser控件
'从注册表升级WebBrowser内核为IE11,HKEY_CURRENT_USER的注册表修改不需要管理员权限.
'Foxtable安装时自动提升过,但是编译后的程序,依然默认使用IE6内核,需要手动升,否则会出现截图无法直接粘贴
Try
Registry.SetValue("HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION",System.Diagnostics.Process.GetCurrentProcess.ProcessName & ".exe",11001)
Catch ex As Exception
MessageBox.Show("狐表调用IE11内核失败,会导致富文本框无法粘贴图片" & vbcrlf & "Error:" & ex.Message )
End Try
Dim wb = e.Form.Controls("webBrowser1").BaseControl
wb.Url = new System.Uri(ProjectPath & "KindEditor\e.html", System.UriKind.Absolute)
Dim ke As new KindEditor '必须创建一个新实例
wb.ObjectForScripting =ke
3.3把html写入富文本框
Dim wb = e.Form.Controls("WebBrowser1").BaseControl
Dim ke = wb.ObjectForScripting
Dim r As Row = Tables("表A").Current
If r IsNot Nothing Then
'把内容写入富文本框里
ke.FullHtml = r("完整html内容")
wb.refresh '刷新
End If
3.4从富文本框读取Html
Dim wb = e.Form.Controls("WebBrowser1").BaseControl
Dim ke = wb.ObjectForScripting
MessageBox.show(ke.FullHtml)
3.5从富文本框读取纯文本
Dim wb = e.Form.Controls("WebBrowser1").BaseControl
Dim ke = wb.ObjectForScripting
MessageBox.show(ke.InnerHtml)在全局代码，利用正则和截取，过滤好了空格、换行符、base64图片。这个纯文本，其实是为了方便存入数据库搜索。
如果直接把html内容存入数据库，尤其有图片的时候，容量超大，动不动就好几m，很快数据库就会膨胀，导致性能严重性下降
3.6设置只读/取消只读
Dim wb As Object = e.Form.Controls("webBrowser1").BaseControl
Dim ke = wb.ObjectForScripting
ke.IsReadOnly =True
wb.refresh
3.7从Word文档读取到富文本框
Dim dlg As New OpenFileDialog
dlg.Filter = "Word文件|*.doc;*.docx"
If dlg.ShowDialog =DialogResult.OK Then
Dim fl As String = dlg.FileName
Dim app As New MSWord.Application
Try
Dim wb = e.Form.Controls("WebBrowser1").BaseControl
wb.Url = new System.Uri(ProjectPath & "KindEditor\e.html", System.UriKind.Absolute)
Dim ke As new KindEditor '必须创建一个新实例
wb.ObjectForScripting =ke
Application.DoEvents
'1打开word并复制全文
Dim doc = app.Documents.Open(fl)
app.Selection.WholeStory()
app.Selection.Copy()
'2富文本框触发粘贴js
wb.Document.InvokeScript("eval", New String() {"editor.clickToolbar('paste');"})
'3关闭doc
doc.Close '必须关闭,否则word会一直在后台被占用
Catch ex As exception
MessageBox.Show(ex.message)
Finally
ClipBoard.Clear '清空剪切板
app.Quit
End Try
End If
3.8富文本框的html与狐表字段绑定（不建议用）
感觉有点bug，不推荐用，还是老老实实自己控制读写好
Dim wb = e.Form.Controls("webBrowser1").BaseControl
Dim ke = wb.ObjectForScripting
Dim r As Row = Tables("表A").Current
If r IsNot Nothing Then
'绑定某个字段,当富文本框变化时,自动变化
ke.FullHtmlBindingField = "表A.完整html内容"
ke.InnerHtmlBindingField = "表A.纯文本内容"
wb.refresh '刷新
End If
4注意的坑
4.1必须关闭备注列的自动记录框
此主题相关图片如下：2.png
4.2强烈建议把Html和纯文本分开存储
- 强烈建议大家把html的内容，直接缓存成本地html文件，然后用的时候直接读取。多人使用时，也可以放在服务器，通过ftp或者http同步下载处理。反正硬盘读写文件的速度，远远高于数据库读写的速度！！！
- 注意狐表内置的数据库或者Access数据库，最大支持2GB，如果你把html存数据库，也不是不行，小心容量。Sql数据库就没上限，只有读写性能瓶颈。
- 纯文本内容才存入数据库，方便like搜索
- 如果你确定只是轻量图文资料，基本都在1m内，存数据库也不是不行，没必要给自己增加麻烦
4.3超过30m文件的读取要用流方法
如果按照上面的方法，把html存在本地，基本都是用FileSys.ReadAllText和 FileSys.WriteAllText。
写入的WriteAllText是没有性能和容量的问题，
读取的ReadAllText，根据版主分享，狐表的最大支持约30m，超过会内存不足，必须换StreamReader流方式读取，这种无限容量
Dim sr = New System.IO.StreamReader(ProjectPath & "我的记事本.txt") '直接从文件路径生成' Dim bigStr As String = sr.ReadToEnd() '读取所有内容 sr.Close '必须释放资源 Output.Show(bigStr)
不过一般也不建议写大量的内容，平时写100m的word文档，也基本只有上百万的标书才会有。
4.4编译后无法粘贴图片
开发过程中，富文本框粘贴图片功能正常，但是发布后发现粘贴不了。那是因为WebBrowser内核版本过低，默认IE6导致的。
狐表程序安装的时候，改过注册表，把foxtable.exe进程的，都启动为IE11内核，但是我们编译后的程序，就不是叫foxtable.exe，于是就默认回IE6内核，导致粘贴功能失效了
所以可以在软件打开时，修改注册表提升好WebBrowser为IE11内核。修改一次后，以后都有效了
Try
Registry.SetValue("HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION",System.Diagnostics.Process.GetCurrentProcess.ProcessName & ".exe",11001)
Catch ex As Exception
MessageBox.Show("狐表调用IE11内核失败,会导致富文本框无法粘贴图片" & vbcrlf & "Error:" & ex.Message )
End Try5完整案例下载
需要20210529后的普通开发版打开。没这个版本也问题不大，下载后把KindEditor文件夹拷贝出来，按照我上面的代码写就行了
随便看看