Техническая поддержка :

Современные решения

для защиты Windows программ

и восстановления исходного кода
Автор: Codenet. Дата публикации: 04.08.2004

Печать RTF

Как вам должно быть известно, то при выводе на печать RTF текста, печать начинается с начала страницы. И ничего с этим не поделаешь? Нет, кое что сделать можно:

В модуль

CODE NOW!
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




В форму (Печать текста)

CODE NOW!
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


Комментарии

отсутствуют

Добавление комментария


Ваше имя (на форуме):

Ваш пароль (на форуме):

Комментарии могут добавлять только пользователи,
зарегистрированные на форуме данного сайта. Если Вы не
зарегистрированы, то сначала зарегистрируйтесь тут

Комментарий:





Главная     Программы     Статьи     Разное     Форум     Контакты