Este proyecto se lo robe a mi amigo Coco y le hice un par de cambios que quede todo dentro del mismo UC, se trata de un user control para hacer una paleta de colores tal como muestra la imagen, este carga es una imagen png (de una paleta de colores), que puede ser leída desde disco o archivo de recurso (no lo carga en modo de diseño por ahorrar una ventana de propiedades.) al hacer clic en la paleta lanza un evento del color seleccionado, también cuenta con un evento que muestra el color donde pasa el cursor.
Este es un módulo clase que sirve para capturar sitios web y poder guardarlos como una imágen, utiliza el motor de Internet explorer. La clase cuenta con un evento y varias propiedades y funciones a modo de ser flexible para cada uso, entre éstas, poder guardar la imágen en varios formatos, PNG, JPG, ICO, etc., tanto en archivo como en stream. Además captura el Favicon de la web en cuestión, como así también otros datos como la descripción y el titulo. Podemos elegir las dimensiones que queramos como entrada y salida.
Como requerimiento sistema operativo Windows XP y posteriores (aunque sólo lo probé en Windows 7, pero no creo que haya inconvenientes).
A continuación pondré tres proyectos en los que utilizaré el módulo clase y mostraré un poco para qué podría servir.
…………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………….
El primero se trata de un proyecto algo simple para mostrar un poco como funciona la clase y sus propiedades.

Snap Website
…………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………….
El segundo se trata de un proyecto más avanzado, con algunos controles de usuario y módulos extra para crear una ventana donde podamos alojar algunos sitios web como accesos directos y mediante algunas combinaciones de teclas mostrar esta ventana. Para más información ver el archivo Leame.txt que se encuentra junto al proyecto.
Para apreciar mejor este proyecto recomiendo compilarlo y tener el tema Aero corriendo (claro ésto si su sistema operativo es windows vista o posterior) en la siguiente captura pueden apreciar una linda interfaz.

Mis sitios favoritos
…………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………….
Y el tercero se trata de un proyecto para crear los clásicos accesos directos en el explorer de windows, con la diferencia que éste permite poner como icono la miniatura de la web, el icono generado cuenta con cuatro dimensiones 256×256 (PNG), 48×48, 32×32 y 16×16, los dos últimos son representados por el favicon de la web (si es que lo tiene).
En este proyecto utilicé IShellLink.tlb para poder crear los accesos directos, ya que fue la mejor opción que encontré para solventar las teclas de acceso rápido.
Nota: los iconos los almacenará en la misma carpeta que el proyecto, si se genera un acceso directo, esta carpeta no debe moverse más para que no se pierda la referencia al icono, por lo que recomiendo, al descomprimir el proyecto elegir una ubicación permanente.
- Vista Iconos muy grandes
- Internet Shortcut Maker
- Vista Contenido
Con la aparición de los nuevos móviles es más frecuente ver imágenes que contienen las coordenadas GPS de donde se tomaron las fotos, esto es aprovechado por algunas redes sociales para sugerir la ubicación de la captura. Si lo desean pueden fijarse desde alguna imágen tomada con el celular, si la tienen almacenada en su PC , dentro de las propiedades (en la pestaña detalles) van a ver las coordenadas, entre otros datos tales como: el tipo de cámara, fecha de captura y demás. Estos datos denominados EXIF o Metadatos, están incrustados en la imágen (como si fuera un archivo de recursos) y es común en los archivos jpg, pero esto no implica que los demás formatos no puedan contener esta información, pueden contener un tipo de archivo XMP (con la misma estructura que un XML).
A continuación voy a poner un módulo que sirve para leer y grabar coordenadas GPS en imágenes y utiliza GDI Plus, este sólo es compatible con EXIF, no con XMP (el cual leerlo no seria el problema, sino guardarlo). El proyecto de descarga contiene un ejemplo con un mapa (google maps) en cual va interactuando con el código de VB, algo básico pero sirve para mostrar y cambiar las coordenadas.
Editado: 09/03/2013 – Se implemento un cuadro de búsqueda para facilitar, la localización en el mapa, el resultado sera el mas próximo, la función esta dentro del código de vb, pero podría hacerse dentro del webbrowser y listar todos los resultados referentes al criterio de búsqueda (para mas información buscar en la ayuda de las apis de gmaps.)

Coordenadas GPS en fotos
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).
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.
Nótese que en Windows Vista y Windows 7 se mantienen los estilos visuales de Windows.
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.
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
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