VB6 - Ruotare un testo con l'oggetto printer

[luciano791]

Ciao a tutti,
ho bisogno di ruotare un testo di 90 gradi utilizzando l'oggetto printer. Non intendo tutta la pagina, ma solo un testo.
Sapete come?

Ciao
Luciano

[umbimbo1]

Inserisci questo codice ed utilizza la funzione WriteText dove in HDC inserisci Printer.HDC ed in Angle inserisci l'angolo.


' Intensità caratteri
Private Const FW_NORMAL = 400
Private Const FW_BOLD = 700

' Carattere logico
Private Const LF_FACESIZE = 32
Private Const LF_FULLFACESIZE = 64

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(LF_FACESIZE) As Byte
End Type

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) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Sub WriteText(hDC As Long, X As Long, Y As Long, angle As Integer, _
ByVal wText As String, _
tHeight As Integer, tFont As String)

Dim hFNT As Long, hFprev As Long
Dim plf As LOGFONT
Dim ind As Integer, res1 As Long

plf.lfEscapement = angle * 10
For ind = 1 To Len(tFont)
plf.lfFaceName(ind - 1) = Asc(Mid(tFont, ind, 1))
Next
plf.lfWeight = FW_BOLD
plf.lfHeight = tHeight

hFNT = CreateFontIndirect(plf)
hFprev = SelectObject(hDC, hFNT)
res1 = TextOut(hDC, X, Y, wText, Len(wText))
res1 = DeleteObject(hFNT)
End Sub

[luciano791]

"umbimbo":Inserisci questo codice ed utilizza la funzione WriteText dove in HDC inserisci Printer.HDC ed in Angle inserisci l'angolo.

grazie mille, ho trovato praticamente lo stesso codice sul sito della Microsoft e ho fatto alcune modifiche. Ora ho il seguente problema:

Se cambio la font di un testo ruotato, alcune font me le accetta (es. Arial Narrow, Courier New), altre non le riconosce (es. Windings, OCR-B-10 BT) e le sostituisce con quello di default (Arial). Se le stesse font le uso semplicemente con l'oggetto printer senza ruotare il testo, allora me le riconosce. Da che può dipendere? Allego il codice.
Grazie

Private Const LF_FACESIZE = 32

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 As String * LF_FACESIZE
End Type

Private Type DOCINFO
   cbSize As Long
   lpszDocName As String
   lpszOutput As String
   lpszDatatype As String
   fwType As Long
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias _
"CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Private 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

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) _
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) As Long ' or Boolean

Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" _
(ByVal hdc As Long, lpdi As DOCINFO) As Long

Private Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) _
As Long

Private Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) _
As Long

Private Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) _
As Long

Sub StampaTestoVerticale(Testo As String, X As Double, Y As Double, TipoFont As String, DESIREDFONTSIZE As Double)
    Dim OutString As String
    Dim lf As LOGFONT
    Dim result As Long
    Dim hOldfont As Long
    Dim hPrintDc As Long
    Dim hFont As Long
    Dim CostanteMM As Double
    
    'Printer.Print "Printer Object"
    
    lf.lfFaceName = Space(Len(lf.lfFaceName))
    lf.lfFaceName = TipoFont & Chr(0)
    
    hPrintDc = Printer.hdc
    OutString = Trim(Testo)

    'CostanteMM = 56.6928579108186
    CostanteMM = 56.6928579108186 / 48 * 40

    lf.lfEscapement = 900
    lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY
    hFont = CreateFontIndirect(lf)
    hOldfont = SelectObject(hPrintDc, hFont)
    result = TextOut(hPrintDc, X * CostanteMM, Y * CostanteMM, OutString, Len(OutString))
    result = SelectObject(hPrintDc, hOldfont)
    result = DeleteObject(hFont)
End Sub

Sub Prova
    StampaTestoVerticale "q", 37, 243, "Courier New", 16  'funziona
    StampaTestoVerticale "q", 47, 243, "Wingdings", 16  'non funziona, sostituisce con Arial
    Printer.FontName = "Wingdings"  'funziona
    Printer.Print "q"
End Sub

[umbimbo1]

Quello che mi viene in mente è :
non è che nella tua stampante non sono configurati quei font ?
Da quello che ricordo i font presenti nell'oggetto printer non sono equivalenti ai font presenti nell'oggetto screen, ma non ho mai approfondito il problema.

[umbimbo1]

Tratto dall'help delle API di windows.

Remarks

The CreateFontIndirect function creates a logical font with the characteristics specified in the LOGFONT structure. When this font is selected by using the SelectObject function, GDI's font mapper attempts to match the logical font with an existing physical font. If it fails to find an exact match, it provides an alternative whose characteristics match as many of the requested characteristics as possible.

[luciano791]

"umbimbo":Quello che mi viene in mente è :
non è che nella tua stampante non sono configurati quei font ?
Da quello che ricordo i font presenti nell'oggetto printer non sono equivalenti ai font presenti nell'oggetto screen, ma non ho mai approfondito il problema.

Ho provato a guardare anche questo. La stampante è il driver AdobePdf, ma nell'elenco delle font previste sono inserite entrambe...
Ho provato anche una stampante da tavolo, stesso risultato.
Forse il motivo va cercato nella struttura di queste due font?
BOH?