Главная страницаОбратная связьКарта сайта

Печать RichTextBox-контрола

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

Public Type RECT
Left As Long

Top As Long
Right As Long
Bottom As Long

End Type

Public 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

Public 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

Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Public Const PHYSICALOFFSETX As Long = 112

Public Const PHYSICALOFFSETY As Long = 113

Public Const WM_USER As Long = &H400

Public Const EM_FORMATRANGE As Long = WM_USER + 57

Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

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 As Long, TopOffset As Long

Dim LeftMargin As Long, TopMargin As Long
Dim RightMargin As Long, BottomMargin As Long

Dim fr As FormatRange
Dim rcDrawTo As RECT, rcPage As RECT
Dim TextLength As Long, NextCharPos As Long


NextCharPos = 0
Printer.ScaleMode = vbTwips

' Get the offsett To the printable area On the page in twips
LeftOffSet = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX) / GetDeviceCaps(Printer.hdc, LOGPIXELSX) * 1440
TopOffSet = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY) / GetDeviceCaps(Printer.hdc, LOGPIXELSY) * 1440

' Calculate the Left, Top, Right, And Bottom margins

LeftMargin = LeftMarginWidth - LeftOffSet
TopMargin = TopMarginHeight - TopOffSet
RightMargin = (Printer.Width - RightMarginWidth) - LeftOffSet
BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffSet

' Set printable area rect
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight

' Set rect in which To print (relative To printable area)

rcDrawTo.Left = LeftMargin
rcDrawTo.Top = TopMargin
rcDrawTo.Right = RightMargin
rcDrawTo.Bottom = BottomMargin

' Get length of text in RTF
TextLength = Len(rtf.Text)

' Loop printing each page Until done

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 ' Indicate start of text through
fr.chrg.cpMax = -1 ' End of the text

fr.rc = rcDrawTo ' Indicate the area On page To draw To
fr.rcPage = rcPage ' Indicate entire size of page


Printer.Print Space(1) ' Re-initialize hDC

' Print the page by sending EM_FORMATRANGE message
NextCharPosition = SendMessage(rtf.hwnd, EM_FORMATRANGE, True, fr)

If NextCharPos <= 0 Or NextCharPos >= TextLength Then Exit Do 'If done Then exit


Printer.NewPage ' Move On To Next page
Loop

' Commit the print job

Printer.EndDoc

' Allow the RTF To free up memory
SendMessage rtf.hwnd, EM_FORMATRANGE, False, ByVal CLng(0)
End Sub

Использование:
' Напечатать содержимое RichTextBox'a с отступами в 1 дюйм (1440 twips) от края листа
PrintRTF RichTextBox1, 1440, 1440, 1440, 1440

Обсудить статью на форуме


Если Вас заинтересовала или понравилась информация программирование на Visual Basic - "Печать RichTextBox-контрола", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!
   


Copyright © 2008 - 2024 Дискета.info