richedit 的所见即所得 - Delphi K.Top 討論區

發表時間：2007-02-14 23:39:11

IP:61.131.xxx.xxx 訂閱

内容如下,摘自一个国内网站,请各位帮忙
四、算法源码
4.1 WYSIWYG（所见即所得）显示
WYSIWYG是What you see is what you get的缩写，表示在编辑过程中显示状态与打印效果一致。
'########################################################
'## 功能： RTF的所见即所得显示（与打印宽度一致）
'##
'## 参数： RTF ：RTF控件
'## MarginLeft ：左边距
'## MarginRight ：右边距
'## MarginTop ：上边距
'## MarginBottom ：下边距
'## PaperWidth ：页宽
'## PaperHeight ：页高
'##
'## 说明：总是以屏幕为度量标准！！！！
'########################################################
Public Sub WYSIWYG_RTF(ByRef RTF As RichTextBox, _
ByVal MarginLeft As Long, _
ByVal MarginRight As Long, _
ByVal MarginTop As Long, _
ByVal MarginBottom As Long, _
ByVal PaperWidth As Long, _
ByVal PaperHeight As Long)

Dim lngOffsetLeft As Long '左边偏移量
Dim lngMarginLeft As Long '左边距
Dim R As Long '返回值
Dim lHDC As Long
lHDC = GetDC(0) '取屏幕的设备上下文
PaperWidth = PaperWidth - MarginLeft – MarginRight '计算可打印文字宽度
R = SendMessage(RTF.hwnd, EM_SETTARGETDEVICE, lHDC, ByVal PaperWidth) '改变行宽，执行渲染
End Sub
4.2 虚拟打印算法（分页，不作实际打印）
先定义下面的结构体用于存储分页结果：
Public Type PageInfo
PageNumber As Long '页码
Start As Long '字符起始位置
End As Long '字符终止位置
ActualHeight As Long '本页实际打印高度
End Type
Public AllPages() As PageInfo '存储分页信息
分页算法如下：
'########################################################
'## 功能：执行虚拟打印，更新RTF的分页信息
'########################################################
Public Sub DoVirtualPrint(ByRef RTF As RichTextBox)
Dim lngLeft As Long
Dim lngTop As Long
Dim lngRight As Long
Dim lngBottom As Long
Dim lngPageCount As Long '总页数

Dim fr As FORMATRANGE '格式化的文本范围
Dim rcDrawTo As RECT '目标文字区域
Dim rcPage As RECT '目标页面区域
Dim lngNextPos As Long '下一个字符位置
Dim R As Long '返回值

Dim lngPWidth As Long '记录目标控件的原始尺寸
Dim lngPHeight As Long

lngPWidth = picBuff.Width
lngPHeight = picBuff.Height
picBuff.Width = mvarPaperWidth
picBuff.Height = mvarPaperHeight
'开始一个打印作业，用于获取有效的目标设备上下文句柄 hDC
picBuff.ScaleMode = vbTwips '设置打印机单位为缇。

'设置可打印页面区域
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = picBuff.ScaleWidth
rcPage.Bottom = picBuff.ScaleHeight

'设置可打印文字区域
lngLeft = MarginLeft
lngTop = MarginTop
lngRight = picBuff.ScaleWidth - MarginRight
lngBottom = picBuff.ScaleHeight - MarginBottom

rcDrawTo.Left = lngLeft
rcDrawTo.Top = lngTop
rcDrawTo.Right = lngRight
rcDrawTo.Bottom = lngBottom

'设置打印指令（FormatRange消息需要的打印信息）
fr.hdc = picBuff.hdc ' 渲染设备
fr.hdcTarget = picBuff.hdc ' 目标设备
fr.rc = rcDrawTo ' 文字矩形区域 IN/OUT
fr.rcPage = rcPage ' 整个页面矩形区域 IN
fr.chrg.cpMin = 0 ' 打印区域的文字开始位置
fr.chrg.cpMax = -1 ' 文字结束位置（-1表示直到末尾）

'获取整个RTF文本长度
Dim lngTmp As Long '用于记录单页字符起始位置

'循环分页打印
Do
'发送 EM_FORMATRANGE 消息进行虚拟打印
lngNextPos = SendMessage(RTF.hWnd, EM_FORMATRANGE, 0, fr) '只分页，不打印
If lngNextPos <= lngTmp Then Exit Do ' 完成所有页面的分页

lngPageCount = lngPageCount 1 ' 页数＋1
'记录分页信息
ReDim Preserve AllPages(1 To lngPageCount) As PageInfo
AllPages(lngPageCount).PageNumber = lngPageCount
AllPages(lngPageCount).ActualHeight = fr.rc.Bottom - fr.rc.Top '实际打印高度
AllPages(lngPageCount).Start = lngTmp
AllPages(lngPageCount).End = lngNextPos

lngTmp = lngNextPos

fr.chrg.cpMin = lngNextPos ' 下一页起始字符位置
fr.hdc = picBuff.hdc
fr.hdcTarget = picBuff.hdc
fr.rc = rcDrawTo ' 必须重新设置文字区域，否则有误！
Loop
PageCount = lngPageCount
AllPages(lngPageCount).End = -1 ' 最后一页结束位置为最末尾

'允许RTF释放内存
R = SendMessage(RTF.hWnd, EM_FORMATRANGE, 0, ByVal CLng(0))
End Sub
4.3 打印算法（按照前面分页的结果进行打印）
'########################################################
'## 功能：打印单独页面到指定设备（打印机/图片框）
'##
'## 参数： PageNumber ：页码
'## objTarget ：打印的目标控件（Printer/图片框）
'########################################################
Public Sub PrintPage(ByRef RTF As RichTextBox , ByVal PageNumber As Long, _
Optional ByRef objTarget As Object = Nothing)

Dim lngOffsetLeft As Long '左边缘偏移量
Dim lngOffsetTop As Long '上边缘偏移量
Dim lngLeft As Long
Dim lngTop As Long
Dim lngRight As Long
Dim lngBottom As Long
Dim lngPageCount As Long '总页数

Dim fr As FORMATRANGE '格式化的文本范围
Dim rcDrawTo As RECT '目标文字区域
Dim rcPage As RECT '目标页面区域
Dim lngNextPos As Long '下一个字符位置
Dim R As Long '返回值

If objTarget Is Nothing Then Set objTarget = Printer
'开始一个打印作业，用于获取有效的目标设备上下文句柄 hDC
objTarget.ScaleMode = vbTwips '设置打印机单位为缇。

'获取打印机可打印区域的边缘偏移量，单位：Pixel
lngOffsetLeft = objTarget.ScaleX(GetDeviceCaps(objTarget.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
lngOffsetTop = objTarget.ScaleY(GetDeviceCaps(objTarget.hdc, PHYSICALOFFSETY), vbPixels, vbTwips)

'设置可打印页面区域
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = objTarget.ScaleWidth
rcPage.Bottom = objTarget.ScaleHeight

'设置可打印文字区域
lngLeft = MarginLeft - lngOffsetLeft
lngTop = MarginTop - lngOffsetTop
lngRight = (objTarget.ScaleWidth - MarginRight)
lngBottom = (objTarget.ScaleHeight - MarginBottom)

rcDrawTo.Left = lngLeft
rcDrawTo.Top = lngTop
rcDrawTo.Right = lngRight
rcDrawTo.Bottom = lngBottom

'设置打印指令（FormatRange消息需要的打印信息）
fr.hdc = objTarget.hdc ' 度量和渲染使用相同的DC
fr.hdcTarget = picBuff.hdc ' 目标控件的DC
fr.rc = rcDrawTo ' 文字矩形区域 IN/OUT
fr.rcPage = rcPage ' 整个页面矩形区域 IN
fr.chrg.cpMin = AllPages(PageNumber).Start ' 打印区域的文字开始位置
fr.chrg.cpMax = AllPages(PageNumber).End ' 文字结束位置（-1表示直到末尾）

'发送 EM_FORMATRANGE 消息进行打印
lngNextPos = SendMessage(RTF.hWnd, EM_FORMATRANGE, 0, fr)
If lngNextPos < AllPages(PageNumber).End Then fr.rc.Bottom = fr.rc.Bottom 1000 '保证一次打印完整页
lngNextPos = SendMessage(RTF.hWnd, EM_FORMATRANGE, 1, fr)

'允许RTF释放内存
R = SendMessage(RTF.hWnd, EM_FORMATRANGE, 0, ByVal CLng(0))
End Sub