Печать RTF

Как вам должно быть известно, то при выводе на печать 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