Ejemplos usando el Api de windows para Visual basic

181 - Obtener ancho y alto de un texto en pixeles

Ejemplo que usa la función GetTextExtentPoint32 , para retornar el ancho y alto de un texto

Declaración de la función

Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _
    ByVal hDC As Long, _
    ByVal lpsz As String, _
    ByVal cbString As Long, _
    lpSize As SIZE) As Long

La función GetTextExtentPoint32 tiene como parámetros

Hdc : DEbemos pasar el Hdc del objeto que tiene el texto al cual se quiere averiguar el ancho y alto

lpsz : El texto

cbString : Tamaño de la cadena

lpSize : Esta estructura retorna el ancho y alto en pixeles

Ejemplo

Los siguiente carga unos datos en unos ComboBox y un ListBox, y alhacer clic en un elemento se obtienen los valores

Nota: los valores los retorna en las variables ( ancho y alto de la función Obtener_Text_Size)

Código fuente en el formulario

Dim Ancho As Long Dim Alto As Long ' Muestra el ancho y alto del texto _ seleccionado en el combo al hacer clic en un item Private Sub Combo1_Click() Dim ret As Long ret = Obtener_Text_Size(Combo1, Combo1.Text, Ancho, Alto) ' Muestra el valor devuelto en la variable Ancho, Alto MsgBox "Ancho del texto : " & Ancho & " Pixeles ", vbInformation MsgBox "Alto del texto : " & Alto & " Pixeles ", vbInformation End Sub ' Muestra el ancho y alto del texto _ seleccionado en el combo al hacer clic en un item Private Sub List1_Click() Dim ret As Long ret = Obtener_Text_Size(List1, List1.Text, Ancho, Alto) ' Muestra el valor devuelto en la variable Ancho, Alto MsgBox "Ancho del texto : " & Ancho & " Pixeles ", vbInformation MsgBox "Alto del texto : " & Alto & " Pixeles ", vbInformation End Sub Private Sub Form_Load() Dim i As Integer ' Agrega lagunos items a al listbox y al combobox List1.FontSize = 30 For i = 1 To 12 List1.AddItem MonthName(i) Next Combo1.FontSize = 12 For i = 1 To 12 Combo1.AddItem MonthName(i) Next End Sub

Código en un módulo bas

Option Explicit 'Declaraciones del Api ' Función que retorna el ancho y alto en pixeles _ de un texto a partir del dispositivo de contexxto indicado Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _ ByVal hDC As Long, _ ByVal lpsz As String, _ ByVal cbString As Long, _ lpSize As SIZE) As Long 'Estructura para usar con GetTextExtentPoint32 ( Devuelve el Ancho y alto en pixeles ) Private Type SIZE cx As Long cy As Long End Type ' Obtiene el Hdc a partir del hwnd Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long ' Función que retorna el Ancho y alto del texto en Pixeles '********************************************************************** Public Function Obtener_Text_Size(Objeto As Object, _ Texto As String, _ Ancho As Long, _ Height As Long) As Long ' Variables para almacenar las caracteristicas _ de la fuente del objeto contenedor del control Dim m_Font As String Dim m_FontSize As Integer Dim m_FontBold As Boolean Dim m_FontItalic As Boolean Dim m_FontUnderline As Boolean Dim Flag As Boolean Dim ret As Long Dim t_Size As SIZE Dim m_DC As Long Dim m_Hwnd As Long On Error Resume Next ' Obtiene el hdc del objeto parent del control m_DC = Objeto.Parent.hDC ' Si hay error, por que el objeto no tiene hdc If Err.Number Then Err.Clear '.. entonces prueba a recuperar el hdc a partir del hwnd (m_DC = GetDC(m_Hwnd)) m_Hwnd = Objeto.Parent.hWnd If Err.Number Then Err.Clear Obtener_Text_Size = True Exit Function End If m_DC = GetDC(m_Hwnd) End If ' Cambia la fuente del objeto parent With Objeto.Parent m_Font = .FontName m_FontSize = .FontSize m_FontBold = .FontBold m_FontItalic = .FontItalic m_FontUnderline = .FontUnderline .FontName = Objeto.FontName .FontSize = Objeto.FontSize .FontBold = Objeto.FontBold .FontItalic = Objeto.FontItalic .FontUnderline = Objeto.FontUnderline End With ' Le envia el Hdc, el texto, el tamaño del texto, y _ la estructura t_Size retorna el ancho y alto en pixeles ret = GetTextExtentPoint32(m_DC, Texto, Len(Texto), t_Size) ' asigna los datos With t_Size Ancho = .cx Height = .cy End With On Error Resume Next If Flag Then 'Restaura la fuente del objeto With Objeto.Parent .FontName = m_Font .FontSize = m_FontSize .FontUnderline = m_FontUnderline .FontBold = m_FontBold .FontItalic = m_FontItalic End With End If End Function

Nota en el ejemplo siguiente a este : Agregar un Scrollbar horizontal a un listbox, se utiliza el Api GetTextExtentPoint32 para poder obtener el ancho del texto del item mas largo del listbox, para luego utilizar este valor para especificarlo como ancho del Scroll

Buscar en Recursos vb