Только на принтере печать под углом текста

[Vlad_Ginz]

Есть процедуры печати текстовых строк под углом, но только или на форме или в PictureBox.
Пробовал менять форму на принтер - печать только по горизонтали.
Что же требуется изменить в параметрах, методах и свойствах ?

[Shurrik]

У меня была такая же проблема и я ее решил через создание своего логического фонта на базе существующего.
А текст приходиться выводить при помощи следующей подпрограммы:

s=" текст "
kx = Printer.CurrentX: ky = Printer.CurrentY: h = Printer.hDC
If nf <> 0 Then dl = DeleteObject(nf)
nf = CreateFontIndirect(lf)
oldhdc = SelectObject(h, nf)
dl = TextOut(h, kx, ky, s, Len(s))
dl = SelectObject(h, oldhdc): dl = DeleteObject(nf)

lf - это логический фон.

[Vlad_Ginz]

А нельзя поподробнее. Непонятно, откуда взялось (nf) и (Lf) и где задается угол наклона ?
Cпасибо Shurrik-у за помощь.

[Shurrik]

Полностью рабочий пример под WINDOWS98, под ХР не проверял.

Код: Выделить всё

Private Type LogFont
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(32) As Byte
End Type

Private Declare Function CreateFontIndirect& Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LogFont)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpstring As String, ByVal nCount As Long)
Private Declare Function GetStockObject& Lib "gdi32" (ByVal nIndex As Long)
Private Declare Function GetObjectAPI& Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any)

Dim lf As LogFont                ' логический фонт

Private Sub Command1_Click()
Dim oldhdc&, nf&, h&, kx&, ky&, dl&, s$
s = "Пример": Printer.Print s

' создаем фонт на базе имеющегося
Printer.FontName = "Courier New Cyr"
Printer.FontSize = 12
oldfont = SelectObject(Printer.hDC, GetStockObject(13&))
di = GetObjectAPI(oldfont, Len(lf), lf)

' изменяем различные параметры
lf.lfHeight = 1.2 * Abs(lf.lfHeight): lf.lfWidth = 0.8 * Abs(lf.lfHeight)
For ug = 1 To 3600 Step 200
lf.lfEscapement = ug ' угол поворота

' выводим на принтер
Printer.CurrentX = 500: Printer.CurrentY = 500
kx = Printer.CurrentX: ky = Printer.CurrentY: h = Printer.hDC
' If nf <> 0 Then dl = DeleteObject(nf) ' не обязательно
nf = CreateFontIndirect(lf)         ' создаем хэндл фонта
oldhdc = SelectObject(h, nf)        ' выбираем его для принтера
dl = TextOut(h, kx, ky, s, Len(s))  ' печатаем текст
dl = SelectObject(h, oldhdc)        ' возвращаем старый фонт
dl = DeleteObject(nf)               ' уничтожаем хэндл фонта
Next ug
Printer.EndDoc
End Sub

[Vlad_Ginz]

Вот это то, что нужно ! Огромное спасибо Shurrik-у.
Тема закрыта !