Ejemplos usando el Api de windows para Visual basic

127 - CreateFontIndirect - Rotar fuente

Volver al Listado Api - Anterior : Siguiente

Ejemplo que permite rotar una fuente utilizando las funciones Api CreateFontIndirect, SelectObject y DeleteObject

Vista del ejemplo:

Formulario que muestra la fuente con rotación dibujada en el control Picturebox

En el código hay una función de ajuste llamada Rotar_Fuente que tiene los siguientes parámetros:

Private Sub Rotar_Fuente( _ Texto As String, _ Size_Fuente As Integer, _ Pos_X As Single, _ Pos_Y As Single, _ Objeto As Object, _ Rotacion As Integer, _ Nombre_Fuente As String, _ color_Fuente As Long) End Sub

El texto, el tamaño de la fuente, la posición x, posicioón Y donde se dibujará, Objeto es donde dibujar (un form, PictureBox, Printer), el grado de rotación, el nombre de la fuente a utilizar y el color de la misma.

Nota: si bien en el combo se listan todas las fuentes del sistema, con algunas no funciona.

También una estructura que utiliza el api llamada LOGFONT, que permite especificar propiedades y algunos valores, como la calidad de la fuente, el ancho, alto. La propiedad de esta estructura que especifica el valor de rotación se llama lfEscapement.

Colocar en un formulario los siguientes controles:

Un Picture1 , un Combo1 llamado Combo_Fuente, un Text1, un ScrollBar1

Código fuente:

Option Explicit ' UDT 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 * 33 End Type ' Declaraciones API 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 Sub Rotar_Fuente(Texto As String, _ Size_Fuente As Integer, _ Pos_X As Single, _ Pos_Y As Single, _ Objeto As Object, _ Rotacion As Integer, _ Nombre_Fuente As String, _ color_Fuente As Long) On Error GoTo errSub Dim t_Fuente As LOGFONT, HPrev_Font As Long, h_Fuente As Long Dim old_Scale As Integer old_Scale = Objeto.ScaleMode Objeto.ScaleMode = vbPixels 'Limpia el objeto Objeto.Cls 'Color de fuente Objeto.ForeColor = color_Fuente ' Asigna a la variable de la estructura LOGFONT el valor de rotación t_Fuente.lfEscapement = 10 * Rotacion 'Nombre de la fuente t_Fuente.lfFacename = Nombre_Fuente + Chr$(0) 'Alto de fuente t_Fuente.lfHeight = (Size_Fuente * -20) / Screen.TwipsPerPixelY 'Crea la fuente h_Fuente = CreateFontIndirect(t_Fuente) HPrev_Font = SelectObject(Objeto.hdc, h_Fuente) 'POosicion X e Y en el objeto para dibujar Objeto.CurrentX = Pos_X Objeto.CurrentY = Pos_Y ' Dibuja el texto Objeto.Print Texto ' Restaura la fuente original h_Fuente = SelectObject(Objeto.hdc, HPrev_Font) DeleteObject h_Fuente ' Reestaura la escala Objeto.ScaleMode = old_Scale 'Error Exit Sub errSub: MsgBox Err.Description, vbCritical Objeto.ScaleMode = old_Scale Exit Sub End Sub Private Sub Form_Load() Dim i As Integer 'Carga las fuentes del sistema. No funciona con todas For i = 0 To Screen.FontCount Combo_Fuente.AddItem Screen.Fonts(i) Next Combo_Fuente = "Arial" 'Valores del Scrollbar para la rotación HScroll1.Min = 0 HScroll1.Max = 360 Picture1.ScaleMode = vbPixels End Sub Private Sub HScroll1_Change() 'Parámetros: _ ' Texto, Tamaño de fuente, posición x e y, _ Objeto donde dibujar, valor de rotación, Nombre de la fuente _ Color de la fuente Call Rotar_Fuente(Text1, _ 50, _ Picture1.ScaleWidth / 3, _ Picture1.ScaleHeight / 2, _ Picture1, _ Not HScroll1.Value - 1, _ Combo_Fuente, _ &HFFC0C0) Me.Caption = " valor de Rotación: " & HScroll1.Value & " Grados" End Sub

Enlaces relacionados

Buscar en Recursos vb