Печать RTF

Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Public 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 Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long Public Const WM_USER As Long = &H400 Public Const EM_FORMATRANGE As Long = WM_USER + 57 Public Const EM_SETTARGETDEVICE As Long = WM_USER + 72 Public Const PHYSICALOFFSETX As Long = 112 Public Const PHYSICALOFFSETY As Long = 113 Public Type Rect Left As Long Top As Long Right As Long Bottom As Long End Type Public Type CharRange cpMin As Long cpMax As Long End Type Public Type FormatRange hdc As Long hdcTarget As Long rc As Rect rcPage As Rect chrg As CharRange End Type Public Function PrintRichText(RTF As RichTextBox, LeftMarginWidth As Long, TopMarginHeight, RightMarginWidth, BottomMarginHeight, Prn) 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 Dim rcPage As Rect Dim TextLength As Long Dim NextCharPosition As Long Dim R As Long Prn.Print Space(1) Prn.ScaleMode = vbTwips LeftOffset = Prn.ScaleX(GetDeviceCaps(Prn.hdc, _ PHYSICALOFFSETX), vbPixels, vbTwips) TopOffset = Prn.ScaleY(GetDeviceCaps(Prn.hdc, _ PHYSICALOFFSETY), vbPixels, vbTwips) LeftMargin = LeftMarginWidth - LeftOffset TopMargin = TopMarginHeight - TopOffset RightMargin = (Prn.Width - RightMarginWidth) - LeftOffset BottomMargin = (Prn.Height - BottomMarginHeight) - TopOffset rcPage.Left = 0 rcPage.Top = 0 rcPage.Right = Prn.ScaleWidth rcPage.Bottom = Prn.ScaleHeight rcDrawTo.Left = LeftMargin rcDrawTo.Top = TopMargin rcDrawTo.Right = RightMargin rcDrawTo.Bottom = BottomMargin fr.hdc = Prn.hdc ’ Use the same DC for measuring and rendering fr.hdcTarget = Prn.hdc ’ Point at printer hDC fr.rc = rcDrawTo ’ Indicate the area on page to drawto fr.rcPage = rcPage ’ Indicate entire size of page fr.chrg.cpMin = 0 ’ Indicate start of text through fr.chrg.cpMax = -1 ’ end of the text TextLength = Len(RTF.Text) Do NextCharPosition = SendMessage(RTF.hwnd, EM_FORMATRANGE, True, fr) If NextCharPosition >= TextLength Then Exit Do ’If done thenexit fr.chrg.cpMin = NextCharPosition ’ Starting position for next Page Prn.NewPage ’ Move on to next page Prn.Print Space(1) ’ Re-initialize hDC fr.hdc = Prn.hdc fr.hdcTarget = Prn.hdc Loop Prn.EndDoc R = SendMessage(RTF.hwnd, EM_FORMATRANGE, False, ByVal CLng(0)) End Function

sPrinter="INSTALLED_Printer_NAME" ’Установленый принтер принтер например: \\GMSVB\PRINTER1 (это у меня) For I = 0 To Printers.Count - 1 If UCase(Printers(I).Port) = UCase(sPrinter) Then Set Printer = Printers(I) PrintRichText RichTexBox, 500, 500, 500, 500, Printer inch. ’ В дюймах Printer.EndDoc Exit For End If Next I