| 
 ВОТ...   Option Explicit  'Примечание: Microsoft RichTextBox обеспечивает печать самого себя  'с помощью метода .SelPrint.  'К сожалению, данный метод не позволяет никоим образом вмешаться  'в процесс, например для печати на загловков страницы или установки  'отступов от края листа. Данный пример решает эту проблему,  'т.к. теперь Вы имеете полный контроль над процессом печати.  Private Const mFontName As String = "Courier New Cyr"  Private Const cTvip As Single = 56.7 'Твипов на мм  Private bStopRtfPrint As Boolean 'Тормозим печать  Private bError As Boolean 'Ошибка печати  Public Type SIZE  cx As Long  cy As Long  End Type  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   '' DrawText() Format Flags  Public Const DT_TOP = &H0  Public Const DT_LEFT = &H0  Public Const DT_CENTER = &H1  Public Const DT_RIGHT = &H2  Public Const DT_VCENTER = &H4  Public Const DT_BOTTOM = &H8  Public Const DT_WORDBREAK = &H10  Public Const DT_SINGLELINE = &H20  Public Const DT_EXPANDTABS = &H40  Public Const DT_TABSTOP = &H80  Public Const DT_NOCLIP = &H100  Public Const DT_EXTERNALLEADING = &H200  Public Const DT_CALCRECT = &H400  Public Const DT_NOPREFIX = &H800  Public Const DT_INTERNAL = &H1000  '------------  'Declare Sub InflateRect Lib "user" (lpRect As RECT, ByVal X%, ByVal Y   Declare Sub InflateRect Lib "user32" (lpRect As RECT, ByVal X%, ByVal Y   Public Declare Function DrawText& Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long)  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  '--------- Печать текста RTF -------------  Public Sub PrintRTF(RTF As RichTextBox, Optional ByVal LeftMarginWidth As Long = 20, Optional ByVal TopMarginHeight As Long = 10, Optional ByVal RightMarginWidth As Long = 10, Optional ByVal BottomMarginHeight As Long = 10, Optional ByVal bPagesAll As Boolean = True, Optional ByVal lPagesNum As Long = 1)  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  Dim lPagesCounter As Long 'Число напечатанных страниц  lPagesCounter = 0   MmToTwip LeftMarginWidth, TopMarginHeight, RightMarginWidth, BottomMarginHeight 'переводим из мм в Твипы ----------  bStopRtfPrint = False  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)  NextCharPos = SendMessage(RTF.hwnd, EM_FORMATRANGE, True, fr)  'DoEvents  If NextCharPos <= 0 Or NextCharPos >= TextLength Then Exit Do 'If done then exit  DoEvents  If bStopRtfPrint = True Then 'Тормозим печать  GoTo PrintRtfEnd:  End If  If bPagesAll = False Then 'Если задано число страниц с 1 по lPagesNum  lPagesCounter = lPagesCounter + 1  If lPagesCounter >= lPagesNum Then  Exit Do  'GoTo PrintRtfEnd:  End If  End If  Printer.NewPage ' Move on to next page  Loop  ' Commit the print job  PrintRtfEnd:  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  'Как показала практика этлт метод печати иногда "взбрыкивает" при печати на сетевые принтеры, которые самостоятельно подключены к сети.. 
Ответить
        |