Leandro Ascierto

Esta es una Api que sirve para dibujar texto con una sombra difuminada al estilo Windows Vista, en el siguiente ejemplo he creado una pequeña función a modo de simplificarla un poco, pero esto depende del uso que se le quiera dar.
Lo malo de esta Api es que requiere que esté inicializada comctl32.dll, es decir, que tendremos que llamar a InitCommonControls y tener el archivo .manifest para que funcione, por lo tanto desde el IDE si no se tiene aplicado los temas de Windows en el VB6.EXE no se mostrará el dibujo del texto y además nos dará un error al llamar a esta Api, el cual lo podremos controlar con On Error, pero bien al compilarlo y teniendo el .manifest funcionará perfectamente.

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function DrawShadowText Lib "comctl32.dll" (ByVal hdc As Long, ByVal lpStr As Long, ByVal nCount As Long, lpRect As RECT, ByVal dwFlags As Long, ByVal crText As Long, ByVal crShadow As Long, ByVal ixOffset As Long, ByVal iyOffset As Long) As Long
Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, col As Long) As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Const DT_CALCRECT As Long = &H400

Public Function DrawTextShadow (DestDC As Long, Text As String, ByVal x As Long, ByVal y As Long, TextColor As OLE_COLOR, ShadowColor As OLE_COLOR, Optional OffsetX As Long = 1, Optional OffsetY As Long = 1) As Boolean

    On Error Resume Next     	'Si no incluye el archivo .manifest el api DrawShadowText provoca un error

    Dim Color1 As Long
    Dim Color2 As Long
    Dim Rec As RECT

    TranslateColor TextColor, 0, Color1
    TranslateColor ShadowColor, 0, Color2

    DrawText DestDC, Text, Len(Text), Rec, DT_CALCRECT
    OffsetRect Rec, x, y

    If Color1 = 0 Then Color1 = 1
    ' El quinto parámetro es la alineación, en este caso 0 = izquierda, 1 centrado, 2 derecha
    DrawTextShadow = DrawShadowText(DestDC, StrPtr(Text), Len(Text), Rec, 0, Color1, Color2, OffsetX, OffsetY)
    ' Esta función podría ser modificada en caso de el api DrawShadowText diera error, podría ser suplementada con DrawText

End Function

Private Sub Form_Initialize()
    InitCommonControls
End Sub

Private Sub Form_Load()

    Me.AutoRedraw = True
    Me.Font.Size = 8

    If DrawTextShadow(Me.hdc, "Hola Mundo", 10, 10, vbBlack, vbRed) = False Then
        MsgBox "Para probar este ejemplo debe compilar este proyecto y agregar un archivo Proyecto1.exe.manifest", vbInformation
    End If

    Me.Font.Size = 12
    DrawTextShadow Me.hdc, "Hola Mundo", 10, 30, vbBlue, vbRed
    Me.Font.Size = 32
    Me.Font.Name = "Times New Roman"
    DrawTextShadow Me.hdc, "Hola Mundo", 10, 50, vbGreen, vbMagenta
    DrawTextShadow Me.hdc, "Hola Mundo", 10, 90, Me.BackColor, vbBlue
    Me.FontBold = True
    DrawTextShadow Me.hdc, "Hola" & vbCrLf & "Mundo", 10, 130, vbWhite, vbBlack, 3, 3
End Sub

Private Sub Timer1_Timer()
    Picture1.Cls
    DrawTextShadow Picture1.hdc, Now, 5, 0, &H333333, &H80000005
End Sub