Jul 102011
 

Módulo clase para agregar imágenes en controles OptionButton, CheckBox, CommandButton y Frame cuando se encuentran los Temas de Windows corriendo en la aplicación (Manifest), esta clase la había creado hace un tiempo atrás, la cual está publicada en Recursos Visual Basic donde la clase podía poner varios iconos para cada estado del botón (MousOver, MouseDown y deshabilitado). En esta versión se quitó dicha propiedad ya que no lo considero muy útil, también eliminé otra propiedad la cual si no estaban los Themes habilitados ponía una imagen de todas formas, una de las ventajas de esta versión es que no se necesita una clase para cada control, ya que con una podemos cubrir todos los controles del formulario o la aplicación, otra es que se puede poner cualquier tipo de imagen  (PNG, JPG, BMP e ICO) y la lectura de las imágenes en varias formas.

Detalle de sus funciones:

  • SetImageFromHandle:  Agrega la imágen desde su handle (Bitmap o Icono).
  • SetGdiPlusImagen: Agrega la imágen desde un hBitmap de GDI+.
  • LoadImageFromFile: Carga una imágen desde un archivo.
  • LoadImageFromRes: Carga una imágen desde el archivo de recurso.
  • LoadImageFromStream: Carga una imágen desde un array de bits.
  • SetMargins: Indica los márgenes de la imágen con respecto al control (Left, Top, Right, Bottom).
  • Align: Propiedad para poner u obtener la alineación de la imágen con respecto al control (Icon_Left, Icon_Right, Icon_Top, Icon_Bottom, Icon_Bottom, Icon_Center).
  • RemoveImage: Remueve la imágen del control.

La fórmula principal de dicho módulo es asociar un ImageList (API) con un ícono al control utilizando SendMessage con el mensaje BCM_SETIMAGELIST y la estructuraBUTTON_IMAGELIST el resto del código solo trata de formar las imágenes en objetos Iconos.

Nota: Cuando prueben el proyecto si están en el IDE seguramente no van a ver ningún icono, ya que no funciona si no está compilado (excepto que tengan el VB6 con Manifest) así que sólo van a ver su funcionamiento cuando corran el ejecutable (recalco para los que no están al tanto, la clase sólo funciona si se utilizan los temas de Windows, para más información ver este link).

Iconos en botones

 
Jul 242010
 

Control de usuario para mostrar un progreso circular indefinido, tal como solemos verlo hoy en día en muchas web o reproductores de videos. Nos puede servir cuando tenemos que realizar operaciones que no sabemos cuánto tiempo pueden llegar a tardar, y así mostrar al usuario que el programa se encuentra pensado, descargado, etc.
Es necesario que dicha operación no cuelgue al programa ya que esto también produciría una interrupción en el timer interno del control y no se mostraría nada.
El control utiliza métodos gráficos de GDI Plus, cuenta con varios aspectos diferentes las cuales pueden crearse jugando con sus propiedades.
A continuación se mostrará una captura gif animada (de baja resolución) de como lucen.

Progress Circular

 
Jul 212010
 

Módulo clase que permite visualizar un menú con los archivos alojados en nuestra PC, su función principal es la de explorar y recuperar la ruta de un archivo, tal como lo hacen los cuadros de diálogo (CommonDialog). Tiene opciones tales como poder filtrar el o los tipos de archivos requeridos, mostrar o no archivos ocultos, establecer algunas carpetas especiales por defecto en el menú principal, posee un Tooltips con algunos datos del archivo y reconoce los accesos directos.
Utiliza la ClsMenuImage para poder insertar íconos en el menú.
La primera vez que llamemos al menú si es una carpeta con muchos archivos puede ser un poco lento al cargar los items, pero una vez que su cache se haya creado es más rápido.
He tenido que deshabilitar algunas funciones que recuperaban palabras del sistema, lo cual hacía que si se ejecutaba en una PC que su sistema operativo no era en castellano las mostraba en su idioma correcto, este supresión se debe a que algunos antivirus detectaban una o varias Apis como una amenaza (Avira Antivirus).

Menú explorer con XP

Menú explorer con Windows 7

 
Jul 182010
 

Este es un módulo clase que sirve para insertar imágenes en el menú, a diferencia del control de usuario HookMenu, este sólo requiere un simple módulo, quizás no cuente con una interfaz sencilla para insertar las imágenes ya que con este módulo tendremos que hacerlo mediante código.
Lo que intenté preservar es que el ícono no modifique el estilo visual de Windows, es decir, el menú no tendrá el aspecto de Office o Ribbon.
También cuenta con la posibilidad de agregarle imágenes a la barra de menú y a los menúes creados mediante Apis (CreatePopupMenu).
La clase soporta imágenes .png, .ico y todos los formatos estándar de imágenes. Este módulo sólo funcionará en Windows XP y posteriores, ya que las versiones anteriores no cuentan con GDI Plus.
En Windows XP el módulo necesita subclasificar la ventana que contiene o llama al menú, pero en Windows Vista y Windows 7 esto no es necesario ya que corrigieron el error que tenían los menúes con bitmaps.

Menú con imágenes XP

Barra de menú con imágenes XP

Nótese que en Windows Vista y Windows 7 se mantienen los estilos visuales de Windows.

Menú con imágenes Seven
Barra de menú con imágenes Seven

 
Abr 272010
 

Esta es una función para dibujar esferas utilizando GDI+. Existen varios diseños, yo elegí este, el cual está conformado con un color gradient central, una luz que la enfoca por encima y una sombra del mismo color que la esfera.
Es muy entretenido jugar con los métodos gráficos de GDI+ ya que nos permite utilizar transparencias, anti-alias y muchas funciones con las cuales podríamos hacer gráficos tal como en Photo Shop.

Esferas


Option Explicit
 
' ------------------------------------------------------------
' Autor:    Leandro I. Ascierto
' Fecha:    27 de Abril de 2010
' Web:      www.leandroascierto.com.ar
' ------------------------------------------------------------

Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipSetSmoothingMode Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mSmoothingMode As Long) As Long
Private Declare Function GdipDeleteBrush Lib "GdiPlus.dll" (ByVal mBrush As Long) As Long
Private Declare Function GdipFillEllipseI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mBrush As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GdipCreatePath Lib "GdiPlus.dll" (ByVal mBrushMode As Long, ByRef mPath As Long) As Long
Private Declare Function GdipDeletePath Lib "GdiPlus.dll" (ByVal mPath As Long) As Long
Private Declare Function GdipCreateLineBrushFromRectI Lib "GdiPlus.dll" (ByRef mRect As RECTL, ByVal mColor1 As Long, ByVal mColor2 As Long, ByVal mMode As LinearGradientMode, ByVal mWrapMode As WrapMode, ByRef mLineGradient As Long) As Long
Private Declare Function GdipAddPathEllipseI Lib "GdiPlus.dll" (ByVal mPath As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
Private Declare Function GdipSetPathGradientCenterColor Lib "GdiPlus.dll" (ByVal mBrush As Long, ByVal mColors As Long) As Long
Private Declare Function GdipSetPathGradientSurroundColorsWithCount Lib "GdiPlus.dll" (ByVal mBrush As Long, ByRef mColor As Long, ByRef mCount As Long) As Long
Private Declare Function GdipCreatePathGradientFromPath Lib "GdiPlus.dll" (ByVal mPath As Long, ByRef mPolyGradient As Long) As Long
Private Declare Function GdipSetLinePresetBlend Lib "GdiPlus.dll" (ByVal mBrush As Long, ByRef mBlend As Long, ByRef mPositions As Single, ByVal mCount As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
 
Private Type RECTL
    Left    As Long
    Top     As Long
    Width   As Long
    Height  As Long
End Type
 
Private Enum LinearGradientMode
    LinearGradientModeHorizontal = &H0
    LinearGradientModeVertical = &H1
    LinearGradientModeForwardDiagonal = &H2
    LinearGradientModeBackwardDiagonal = &H3
End Enum
 
Private Enum WrapMode
    WrapModeTile = &H0
    WrapModeTileFlipX = &H1
    WrapModeTileFlipy = &H2
    WrapModeTileFlipXY = &H3
    WrapModeClamp = &H4
End Enum
 
Private Type GDIPlusStartupInput
    GdiPlusVersion                      As Long
    DebugEventCallback                  As Long
    SuppressBackgroundThread            As Long
    SuppressExternalCodecs              As Long
End Type
 
Private Const SmoothingModeAntiAlias    As Long = &H4
Dim GdipToken As Long
 
 
Private Sub Form_Load()
    Call InitGDI
    Me.AutoRedraw = True
    DrawSphere Me.hdc, vbBlue, 10, 20, 150, 150
    DrawSphere Me.hdc, vbGreen, 180, 20, 150, 150
    DrawSphere Me.hdc, vbRed, 350, 20, 150, 150
    DrawSphere Me.hdc, vbYellow, 10, 210, 150, 150
    DrawSphere Me.hdc, vbBlack, 180, 210, 150, 150
    DrawSphere Me.hdc, vbMagenta, 350, 210, 150, 150
    DrawSphere Me.hdc, vbCyan, 10, 400, 150, 150
    DrawSphere Me.hdc, vbWhite, 180, 400, 150, 150
    DrawSphere Me.hdc, &H99FF&, 350, 400, 150, 150
End Sub
 
 
Private Sub Form_Unload(Cancel As Integer)
    Call TerminateGDI
End Sub
 
 
Public Function DrawSphere(ByVal hdc As Long, _
                           ByVal lColor As Long, _
                           ByVal X As Long, _
                           ByVal Y As Long, _
                           ByVal Width As Long, _
                           ByVal Height As Long, _
                           Optional ByVal bDrawShadow As Boolean = True, _
                           Optional ByVal lAlpha As Long = 100) As Boolean
 
    Dim hGraphics As Long
    Dim hBrush As Long
    Dim mPath As Long
    Dim mRect As RECTL
    Dim col(2) As Long
    Dim pos(2) As Single
 
    'crea un grafico a partir de un hdc
    If GdipCreateFromHDC(hdc, hGraphics) = 0 Then
 
        'aplica el modo antialias
        Call GdipSetSmoothingMode(hGraphics, SmoothingModeAntiAlias)
 
 
        ' ----------------------------- Shadow -------------------------------------
        If bDrawShadow Then
 
            Call GdipCreatePath(&H0, mPath)                                                         'Crea un Path
            GdipAddPathEllipseI mPath, X, Y + Height / 1.1, Width, Height / 4                       'Dibuja un Circulo
            GdipCreatePathGradientFromPath mPath, hBrush                                            'Crea una brocha a partir de el Path
            
            GdipSetPathGradientCenterColor hBrush, ConvertColor(lColor, lAlpha / 3)                 'Asigna un color central a la brocha
            GdipSetPathGradientSurroundColorsWithCount hBrush, 0, 1                                 'Aplica un color Transparente al contorno de la brocha/circulo
    
            Call GdipFillEllipseI(hGraphics, hBrush, X, Y + Height / 1.1, Width, Height / 4)        'dibuja la sombra en el grafico
            
            Call GdipDeleteBrush(hBrush)                                                            'Descarga la brocha
            Call GdipDeletePath(mPath)                                                              'Descarga el Path
        End If
 
        '----------------------------- Sphere -------------------------------------
               
        Call GdipCreatePath(&H0, mPath)                                                              'Crea un Path
        
        GdipAddPathEllipseI mPath, X - (Width / 1.75), Y - Height / 2, Width * 2, Height * 2         'Dibuja un Circulo en el path
        GdipCreatePathGradientFromPath mPath, hBrush                                                 'Crea una brocha a partir de el Path
        GdipSetPathGradientCenterColor hBrush, ConvertColor(lColor, lAlpha)                          'Asigna el color central a la brocha
        GdipSetPathGradientSurroundColorsWithCount hBrush, ConvertColor(ShiftColor(lColor, vbBlack, 100), lAlpha), 1 'Aplica un color mas opaco al gradient de la brocha
        
        Call GdipFillEllipseI(hGraphics, hBrush, X, Y, Width, Height)                                'Dibuja un circulo en el grafico
        Call GdipDeleteBrush(hBrush)                                                                 'Descarga la brocha
        Call GdipDeletePath(mPath)                                                                   'Descarga el Path
        
        '----------------------------- Light -------------------------------------
        
        mRect.Left = X + Width / 10
        mRect.Top = Y + Height / 50
        mRect.Width = Width - Width / 5
        mRect.Height = Height / 1.5
 
        GdipCreateLineBrushFromRectI mRect, 0, 0, LinearGradientModeVertical, WrapModeTileFlipy, hBrush 'crea una brocha de dos colores

        col(0) = ConvertColor(vbWhite, lAlpha / 1.25)           'Primer color
        col(1) = 0                                              'segundo color transparente
        col(2) = 0                                              'tercer color transparente

        pos(0) = 0
        pos(1) = 0.6                                            'El 60% de la brocha va a ser transparente
        pos(2) = 1
 
        Call GdipSetLinePresetBlend(hBrush, col(0), pos(0), 3)  'Asigna los valores para la brocha
        Call GdipFillEllipseI(hGraphics, hBrush, mRect.Left, mRect.Top, mRect.Width, mRect.Height - 1) 'dibuja un circulo aplastado semi transparente
        Call GdipDeleteBrush(hBrush)                            'Elimina la brocha
        
        ' ------------------------------------------------------------------------

        Call GdipDeleteGraphics(hGraphics)                       'Elimina el grafico.
    End If
 
End Function
 
' funcion para convertir un color long a un BGRA(Blue, Green, Red, Alpha)
Private Function ConvertColor(Color As Long, Opacity As Long) As Long
    Dim BGRA(0 To 3) As Byte
 
    BGRA(3) = CByte((Abs(Opacity) / 100) * 255)
    BGRA(0) = ((Color \ &H10000) And &HFF)
    BGRA(1) = ((Color \ &H100) And &HFF)
    BGRA(2) = (Color And &HFF)
    CopyMemory ConvertColor, BGRA(0), 4&
End Function
 
'Funcion para combinar dos colores
Private Function ShiftColor(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long
 
    Dim clrFore(3)         As Byte
    Dim clrBack(3)         As Byte
 
    OleTranslateColor clrFirst, 0, VarPtr(clrFore(0))
    OleTranslateColor clrSecond, 0, VarPtr(clrBack(0))
 
    clrFore(0) = (clrFore(0) * lAlpha + clrBack(0) * (255 - lAlpha)) / 255
    clrFore(1) = (clrFore(1) * lAlpha + clrBack(1) * (255 - lAlpha)) / 255
    clrFore(2) = (clrFore(2) * lAlpha + clrBack(2) * (255 - lAlpha)) / 255
 
    CopyMemory ShiftColor, clrFore(0), 4
 
End Function
 
'Inicia GDI+
Private Sub InitGDI()
    Dim GdipStartupInput As GDIPlusStartupInput
    GdipStartupInput.GdiPlusVersion = 1&
    Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
 
'Termina GDI+
Private Sub TerminateGDI()
    Call GdiplusShutdown(GdipToken)
End Sub
 

 
Dic 072009
 

Modulo Clase para dibujar texto utilizando GDI+ tiene funciones básicas como poder asignar la fuente, color, alineación, alineación vertical, Flags del formato, Trimming, Opacity. Para los que ya utilizaron alguna vez el api DrawText de «User32» no les resultara muy difícil de implementar.

Option Explicit
'--------------------------------------------
'Autor: Leandro Ascierto
'Web:   www.leandroascierto.com.ar
'Date:  27/12/2009
'--------------------------------------------
Private Declare Function GdipCreateFont Lib "gdiplus" (ByVal fontFamily As Long, ByVal emSize As Single, ByVal Style As GDIPLUS_FONTSTYLE, ByVal UNIT As Long, createdfont As Long) As Long
Private Declare Function GdipCreateFontFamilyFromName Lib "gdiplus" (ByVal name As String, ByVal fontCollection As Long, fontFamily As Long) As Long
Private Declare Function GdipCreateSolidFill Lib "gdiplus" (ByVal argb As Long, brush As Long) As Long
Private Declare Function GdipCreateStringFormat Lib "gdiplus" (ByVal formatAttributes As Long, ByVal language As Integer, StringFormat As Long) As Long
Private Declare Function GdipDeleteBrush Lib "gdiplus" (ByVal brush As Long) As Long
Private Declare Function GdipDeleteFont Lib "gdiplus" (ByVal curFont As Long) As Long
Private Declare Function GdipDeleteFontFamily Lib "gdiplus" (ByVal fontFamily As Long) As Long
Private Declare Function GdipDeleteStringFormat Lib "gdiplus" (ByVal StringFormat As Long) As Long
Private Declare Function GdipDrawString Lib "gdiplus" (ByVal graphics As Long, ByVal str As String, ByVal Length As Long, ByVal thefont As Long, layoutRect As RECTF, ByVal StringFormat As Long, ByVal brush As Long) As Long
Private Declare Function GdipSetStringFormatAlign Lib "gdiplus" (ByVal StringFormat As Long, ByVal Align As StringAlignment) As Long
Private Declare Function GdipSetStringFormatLineAlign Lib "gdiplus" (ByVal StringFormat As Long, ByVal Align As StringAlignment) As Long
Private Declare Function GdipSetStringFormatFlags Lib "GdiPlus.dll" (ByVal mFormat As Long, ByVal mFlags As StringFormatFlags) As Long
Private Declare Function GdipSetStringFormatTrimming Lib "GdiPlus.dll" (ByVal mFormat As Long, ByVal mTrimming As StringTrimming) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal Hdc As Long, hGraphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal hGraphics As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal Hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
 
Private Type GdiplusStartupInput
    GdiplusVersion           As Long
    DebugEventCallback       As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs   As Long
End Type
 
Private Type RECTF
    Left    As Single
    Top     As Single
    Width   As Single
    Height  As Single
End Type
 
Public Enum GDIPLUS_FONTSTYLE
    FontStyleRegular = 0
    FontStyleBold = 1
    FontStyleItalic = 2
    FontStyleBoldItalic = 3
    FontStyleUnderline = 4
    FontStyleStrikeout = 8
End Enum
 
Public Enum StringAlignment
    StringAlignmentNear = &H0
    StringAlignmentCenter = &H1
    StringAlignmentFar = &H2
End Enum
 
Public Enum StringTrimming
    StringTrimmingNone = &H0
    StringTrimmingCharacter = &H1
    StringTrimmingWord = &H2
    StringTrimmingEllipsisCharacter = &H3
    StringTrimmingEllipsisWord = &H4
    StringTrimmingEllipsisPath = &H5
End Enum
 
Public Enum StringFormatFlags
    StringFormatFlagsNone = &H0
    StringFormatFlagsDirectionRightToLeft = &H1
    StringFormatFlagsDirectionVertical = &H2
    StringFormatFlagsNoFitBlackBox = &H4
    StringFormatFlagsDisplayFormatControl = &H20
    StringFormatFlagsNoFontFallback = &H400
    StringFormatFlagsMeasureTrailingSpaces = &H800
    StringFormatFlagsNoWrap = &H1000
    StringFormatFlagsLineLimit = &H2000
    StringFormatFlagsNoClip = &H4000
End Enum
 
Private Const LOGPIXELSY         As Long = 90
 
Private m_Font                  As StdFont
Private m_Color                 As OLE_COLOR
Private m_Alignment             As StringAlignment
Private m_VerticalAlignment     As StringAlignment
Private m_FormatFlags           As StringFormatFlags
Private m_Trimming              As StringTrimming
Private m_Opacity               As Long
 
Private Sub Class_Initialize()
    Set m_Font = New StdFont
    m_Font.name = "Tahoma"
    m_Color = vbWindowText
    m_Opacity = 100
End Sub
 
Private Sub Class_Terminate()
    Set m_Font = Nothing
End Sub
 
Public Property Get Font() As StdFont
    Set Font = m_Font
End Property
 
Public Property Let Font(ByVal NewFont As StdFont)
    Set m_Font = NewFont
End Property
 
Public Property Get Color() As OLE_COLOR
    Color = m_Color
End Property
 
Public Property Let Color(ByVal NewColor As OLE_COLOR)
    m_Color = NewColor
End Property
 
Public Property Get Alignment() As StringAlignment
    Alignment = m_Alignment
End Property
 
Public Property Let Alignment(ByVal NewAlignment As StringAlignment)
    m_Alignment = NewAlignment
End Property
 
Public Property Get VerticalAlignment() As StringAlignment
    VerticalAlignment = m_VerticalAlignment
End Property
 
Public Property Let VerticalAlignment(ByVal NewVerticalAlignment As StringAlignment)
    m_VerticalAlignment = NewVerticalAlignment
End Property
 
Public Property Get FormatFlags() As StringFormatFlags
    FormatFlags = m_FormatFlags
End Property
 
Public Property Let FormatFlags(ByVal NewFormatFlags As StringFormatFlags)
    m_FormatFlags = NewFormatFlags
End Property
 
Public Property Get Trimming() As StringTrimming
    Trimming = m_Trimming
End Property
 
Public Property Let Trimming(ByVal NewTrimming As StringTrimming)
    m_Trimming = NewTrimming
End Property
 
Public Property Get Opacity() As Long
    Opacity = m_Opacity
End Property
 
Public Property Let Opacity(ByVal NewOpacity As Long) 
    m_Opacity = NewOpacity 
    If m_Opacity < 0 Then
        Opacity = 0
    ElseIf m_Opacity > 100 Then
        m_Opacity = 100
    End If 
End Property
  
Public Function DrawString(ByVal Hdc As Long, _
                        ByVal Text As String, _
                        ByVal X As Single, _
                        ByVal Y As Single, _
                        Optional ByVal Width As Single, _
                        Optional ByVal Height As Single) As Boolean
 
    On Error Resume Next
 
    Dim hGraphic As Long
    Dim lBrush As Long
    Dim lFontFamily As Long
    Dim lCurrentFont As Long
    Dim lFontSize As Long
    Dim lFontStyle As GDIPLUS_FONTSTYLE
    Dim lFormat As Long
    Dim RctText As RECTF
    Dim GdiToken As Long
    Dim GDIsi As GdiplusStartupInput
 
    GDIsi.GdiplusVersion = 1&
 
    If GdiplusStartup(GdiToken, GDIsi) = 0 Then 
        Call GdipCreateFromHDC(Hdc, hGraphic) 
        GdipCreateSolidFill ConvertColor(m_Color, m_Opacity), lBrush 
        GdipCreateFontFamilyFromName StrConv(m_Font.name, vbUnicode), 0, lFontFamily
 
        If m_Font.Bold Then lFontStyle = lFontStyle Or FontStyleBold
        If m_Font.Italic Then lFontStyle = lFontStyle Or FontStyleItalic
        If m_Font.Strikethrough Then lFontStyle = lFontStyle Or FontStyleStrikeout
        If m_Font.Underline Then lFontStyle = lFontStyle Or FontStyleUnderline
 
        lFontSize = MulDiv(m_Font.Size, GetDeviceCaps(Hdc, LOGPIXELSY), 72) 
        GdipCreateFont lFontFamily, lFontSize, lFontStyle, 0, lCurrentFont
 
        If GdipCreateStringFormat(0, 0, lFormat) = 0 Then
            If m_FormatFlags Then GdipSetStringFormatFlags lFormat, m_FormatFlags
            If m_Alignment Then GdipSetStringFormatAlign lFormat, m_Alignment
            If m_Trimming Then GdipSetStringFormatTrimming lFormat, m_Trimming
            If m_VerticalAlignment Then GdipSetStringFormatLineAlign lFormat, m_VerticalAlignment
        End If
 
        With RctText
            .Left = X
            .Top = Y
            .Width = Width
            .Height = Height
        End With
 
        DrawString = GdipDrawString(hGraphic, StrConv(Text, vbUnicode), -1, lCurrentFont, RctText, lFormat, lBrush) = 0
 
        GdipDeleteStringFormat lFormat
        GdipDeleteFont lCurrentFont
        GdipDeleteFontFamily lFontFamily
        GdipDeleteBrush lBrush
        GdipDeleteGraphics hGraphic
        GdiplusShutdown GdiToken
    End If
End Function
  
Private Function ConvertColor(Color As Long, Opacity As Long) As Long
    Dim BGRA(0 To 3) As Byte
 
    BGRA(3) = CByte((Abs(Opacity) / 100) * 255)
    BGRA(0) = ((Color \ &H10000) And &HFF)
    BGRA(1) = ((Color \ &H100) And &HFF)
    BGRA(2) = (Color And &HFF)
    CopyMemory ConvertColor, BGRA(0), 4&
End Function

 
Dic 032009
 

Este es un Gadget para Taringa.net programado en Visual Basic 6 muestra todos los últimos post realizados. También ordena por categorías, si dan un clic en la lista mostrara una ventanita con la información del post, y con doble clic abre el navegador en dicho post.
También sirve para Poringa.net, tiene algunas opciones como elegir el tiempo de actualizado, poner un icono en la barra de tareas, controlar la opacidad de la ventana, contraerla a un mínimo o expandirla. Iniciar con Windows y otras más.

CapturaTaringa.png
CapturaPoringa.png
TaringaOpciones.png
MenuPoringa.png

Descargar .zip con el ejecutable.

Para programadores en Visual Basic 6 el código de fuente.