May 102009
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