| Pregunta: | 8250 - IMPRIMIR TEXTO ROTADO |
| Autor: | ALEJANDRO COZART PEÑA |
| Cómo puedo hacerle para imprimir texto en diferentes ángulos sin perder las características como la fuente, bold, subrayado, tamaño, etc. y enviar el resultado a la impresora | |
| Respuesta: | José Ariel Limandri |
| Proba con este código.
Cualquier duda mandame un mail Option Explicit Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) 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 Sub DrawRotatedText(ByVal target As Object, _ ByVal txt As String, _ ByVal X As Single, ByVal Y As Single, _ ByVal font_name As String, ByVal size As Long, _ ByVal weight As Long, ByVal escapement As Long, _ ByVal use_italic As Boolean, ByVal use_underline As Boolean, _ ByVal use_strikethrough As Boolean) Const CLIP_LH_ANGLES = 16 ' Needed for tilted fonts. Const PI = 3.14159625 Const PI_180 = PI / 180# Dim newfont As Long Dim oldfont As Long newfont = CreateFont(size, 0, _ escapement, escapement, weight, _ use_italic, use_underline, _ use_strikethrough, 0, 0, _ CLIP_LH_ANGLES, 0, 0, font_name) ' Select the new font. oldfont = SelectObject(target.hdc, newfont) ' Display the text. target.CurrentX = X target.CurrentY = Y target.Print txt ' Restore the original font. newfont = SelectObject(target.hdc, oldfont) ' Free font resources (important!) DeleteObject newfont End Sub | |