VBCoding Библиотека кодов Visual Basic 6 Использование ActiveX Печать содержимого RichTextBox

Visual Basic 6
Печать содержимого RichTextBox
Печать содержимого RichTextBox с полным контролем над печатью.

Примечание: Microsoft RichTextBox обеспечивает печать самого себя с помощью метода .SelPrint. К сожалению, данный метод не позволяет никоим образом вмешаться в процесс, например для печати на загловков страницы или установки отступов от края листа. Данный пример решает эту проблему, т.к. теперь Вы имеете полный контроль над процессом печати.
Этот e-mail адрес защищен от спам-ботов, для его просмотра у Вас должен быть включен Javascript

 

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type CharRange
cpMin As Long ' First character of range (0 for start of doc)
cpMax As Long ' Last character of range (-1 for end of doc)
End Type
Private Type FormatRange
hdc As Long ' Actual DC to draw on
hdcTarget As Long ' Target DC for determining text formatting
rc As RECT ' Region of the DC to draw to (in twips)
rcPage As RECT ' Region of the entire DC (page size) (in twips)
chrg As CharRange ' Range of text to draw (see above declaration)
End Type
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long

Public Sub PrintRTF(rtf As RichTextBox, LeftMarginWidth As Long, TopMarginHeight, RightMarginWidth, BottomMarginHeight)
Dim LeftOffset&, TopOffset&, LeftMargin&, TopMargin&
Dim NextCharPosition&, RightMargin&, BottomMargin&
Dim rcDrawTo As RECT, rcPage As RECT
Dim TextLength&, NextCharPos&
Dim fr As FormatRange

NextCharPos = 0
Printer.ScaleMode = vbTwips
'А тут мы определяем доступную область печати в твипах
LeftOffset = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX) / GetDeviceCaps(Printer.hdc, LOGPIXELSX) * 1440
TopOffset = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY) / GetDeviceCaps(Printer.hdc, LOGPIXELSY) * 1440
'Считаем левый, верхний, правый и нижний отступы
LeftMargin = LeftMarginWidth - LeftOffset
TopMargin = TopMarginHeight - TopOffset
RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset
'Устанавливаем область печати на одной странице
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight
'Устанавливаем область на которой мы будем печатать.
'Это уже относится к области печати.
rcDrawTo.Left = LeftMargin
rcDrawTo.Top = TopMargin
rcDrawTo.Right = RightMargin
rcDrawTo.Bottom = BottomMargin
'Считаем сколько нам печатать текста
TextLength = Len(rtf.Text)
'Дальше мы печатаем каждую страницу в документе, пока не прекратился весь текст
Do
' Set up the print instructions
fr.hdc = Printer.hdc ' Use the same DC for measuring and rendering
fr.hdcTarget = Printer.hdc ' Point at Printer hDC
fr.chrg.cpMin = NextCharPos ' Вычисляем начало печати
fr.chrg.cpMax = -1 ' и конец печати
fr.rc = rcDrawTo ' Indicate the area on page to draw to
fr.rcPage = rcPage ' Indicate entire size of page
Printer.Print Space(1) ' Определяем заново hDC
'Печатем при помощи посылки EM_FORMATRANGE сообщения
NextCharPosition = SendMessage(rtf.hwnd, EM_FORMATRANGE, True, fr)
'Если все сделано, то выходим
If NextCharPos <= 0 Or NextCharPos >= TextLength Then Exit Do
' Переключаемся на следующую страницу
Printer.NewPage
Loop
'Завершаем печать
Printer.EndDoc
' Allow the RTF to free up memory
'Я тут не понял - что за освобождение памяти? Очищение памяти у RTF?
SendMessage rtf.hwnd, EM_FORMATRANGE, False, ByVal CLng(0)
End Sub

Private Sub Command1_Click()
'Напечатать содержимое RichTextBox'a с отступами в 1 дюйм (1440 twips) от края листа
'Примечание для тех, кто не знает: 1 дюйм = 2.54 см
PrintRTF RichTextBox1, 1440, 1440, 1440, 1440
End Sub

 

Источник: http://www.vbnet.ru/ 
 

Добавить комментарий


Защитный код
Обновить

 
VBCoding Библиотека кодов Visual Basic 6 Использование ActiveX Печать содержимого RichTextBox  
Powered by Exponenta -