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