Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function GetVersion Lib "kernel32.dll" () As Long
Public Declare Function DwmExtendFrameIntoClientArea Lib "dwmapi.dll" (ByVal hwnd As Long, margin As MARGINS) As Long
Public Declare Function DwmIsCompositionEnabled Lib "dwmapi.dll" (ByRef enabledptr As Boolean) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Public Declare Sub InitCommonControls Lib "COMCTL32" ()
Public Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal Handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetCurrentObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Declare Function GetTextColor Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GetBkColor Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function OpenThemeData Lib "UxTheme" (ByVal hwnd As Long, ByVal szClasses As Long) As Long
Private Declare Function CloseThemeData Lib "UxTheme" (ByVal hTheme As Long) As Long
Private Declare Function DrawThemeTextEx Lib "UxTheme" (ByVal hTheme As Long, ByVal hdc As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal Text As Long, ByVal iCharCount As Long, ByVal dwFlags As Long, pRect As RECT, pOptions As DTTOPTS) As Long
Private Declare Function DrawThemeText Lib "uxtheme.dll" (ByVal hTheme As Long, ByVal hdc As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal pszText As Long, ByVal iCharCount As Long, ByVal dwTextFlag As Long, ByVal dwTextFlags2 As Long, pRect As RECT) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Sub OutputDebugString Lib "kernel32.dll" Alias "OutputDebugStringA" (ByVal lpOutputString As String)

Public Type MARGINS
    m_Left As Long
    m_Right As Long
    m_Top As Long
    m_Button As Long
End Type

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

Private Type BITMAPINFOHEADER
    biSize                  As Long
    biWidth                 As Long
    biHeight                As Long
    biPlanes                As Integer
    biBitCount              As Integer
    biCompression           As Long
    biSizeImage             As Long
    biXPelsPerMeter         As Long
    biYPelsPerMeter         As Long
    biClrUsed               As Long
    biClrImportant          As Long
End Type

Private Type RGBQUAD
    rgbBlue                 As Byte
    rgbGreen                As Byte
    rgbRed                  As Byte
    rgbReserved             As Byte
End Type

Private Type BITMAPINFO
    bmiHeader               As BITMAPINFOHEADER
    bmiColors               As RGBQUAD
End Type

Private Type POINTAPI
    X                       As Long
    Y                       As Long
End Type

Private Type DTTOPTS
    dwSize                  As Long
    dwFlags                 As Long
    crText                  As Long
    crBorder                As Long
    crShadow                As Long
    iTextShadowType         As Long
    ptShadowOffset          As POINTAPI
    iBorderSize             As Long
    iFontPropId             As Long
    iColorPropId            As Long
    iStateId                As Long
    fApplyOverlay           As Long
    iGlowSize               As Long
    pfnDrawTextCallback     As Long
    lParam                  As Long
End Type

Private Const DTT_TEXTCOLOR     As Long = &H1       ' (1UL << 0)      // crText has been specified
Private Const DTT_BORDERCOLOR   As Long = &H2       ' (1UL << 1)      // crBorder has been specified
Private Const DTT_SHADOWCOLOR   As Long = &H4       ' (1UL << 2)      // crShadow has been specified
Private Const DTT_SHADOWTYPE    As Long = &H8       ' (1UL << 3)      // iTextShadowType has been specified
Private Const DTT_SHADOWOFFSET  As Long = &H10      ' (1UL << 4)      // ptShadowOffset has been specified
Private Const DTT_BORDERSIZE    As Long = &H20      ' (1UL << 5)      // iBorderSize has been specified
Private Const DTT_FONTPROP      As Long = &H40      ' (1UL << 6)      // iFontPropId has been specified
Private Const DTT_COLORPROP     As Long = &H80      ' (1UL << 7)      // iColorPropId has been specified
Private Const DTT_STATEID       As Long = &H100     ' (1UL << 8)      // IStateId has been specified
Private Const DTT_CALCRECT      As Long = &H200     ' (1UL << 9)      // Use pRect as and in/out parameter
Private Const DTT_APPLYOVERLAY  As Long = &H400     ' (1UL << 10)     // fApplyOverlay has been specified
Private Const DTT_GLOWSIZE      As Long = &H800     ' (1UL << 11)     // iGlowSize has been specified
Private Const DTT_CALLBACK      As Long = &H1000    ' (1UL << 12)     // pfnDrawTextCallback has been specified
Private Const DTT_COMPOSITED    As Long = &H2000    ' (1UL << 13)     // Draws text with antialiased alpha (needs a DIB section)

Private Const DT_SINGLELINE     As Long = &H20
Private Const DT_CENTER         As Long = &H1
Private Const DT_VCENTER        As Long = &H4
Private Const DT_NOPREFIX       As Long = &H800

Private Const OBJ_FONT          As Long = &H6

Private Const GWL_WNDPROC       As Long = (-4)

Private Const WM_HOTKEY         As Long = &H312
Private Const WM_NCHITTEST      As Long = &H84
Private Const WM_SYSCOLORCHANGE As Long = &H15
Private Const WM_ACTIVATEAPP     As Long = &H1C

Public Const HWND_TOPMOST       As Long = -1
Public Const SWP_NOSIZE         As Long = &H1
Public Const SWP_NOMOVE         As Long = &H2
Public Const SWP_SHOWWINDOW     As Long = &H40

Public Const WM_NCLBUTTONDOWN   As Long = &HA1
Public Const HTCAPTION          As Long = &H2
Public Const SW_SHOW            As Long = 5

Public Const MOD_ALT            As Long = &H1
Public Const MOD_CONTROL        As Long = &H2
Public Const MOD_SHIFT          As Long = &H4

Public Const GWL_EXSTYLE As Long = -20
Public Const WS_EX_APPWINDOW As Long = &H40000

Public Const HOTKEY_MOSTRAR     As Long = &HBFFF&
Public Const HOTKEY_CERRAR      As Long = &HBFAA&

Public hMod                     As Long
Public sURLReturn               As String
Private PrevProc                As Long


Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tRECT As RECT
    Dim lLeft As Long, lTop As Long
    
    Select Case uMsg
    
        Case WM_NCHITTEST
            WindowProc = 1
            Exit Function
            
        Case WM_SYSCOLORCHANGE
            Dim IsAero As Boolean
            Dim oColor As OLE_COLOR
            Dim MG As MARGINS
            
            If (GetVersion And &HFF) > 5 Then
                DoEvents
                Sleep 200 ' Suele necesitar un tiempo, sobre todo cuando la ventana esta oculta.
                oColor = vbActiveTitleBar
                DwmIsCompositionEnabled IsAero
                'OutputDebugString "IsAero: " & IsAero
                If IsAero Then
                    With MG
                        .m_Left = -1
                        .m_Top = -1
                        .m_Right = -1
                        .m_Button = -1
                    End With
                    If DwmExtendFrameIntoClientArea(hwnd, MG) = 0 Then
                        oColor = vbBlack
                    End If
                End If
            Else
                oColor = vbInactiveTitleBar
            End If
            
            With Form1
                .BackColor = oColor
                .PicTitle.BackColor = oColor
                .PicFooter.BackColor = oColor
            End With
            
        Case WM_HOTKEY
            
            If wParam = HOTKEY_MOSTRAR Then
                If GetWindowRect(hwnd, tRECT) Then
                    lLeft = ((Screen.Width / Screen.TwipsPerPixelX) / 2) - ((tRECT.Right - tRECT.Left) / 2)
                    lTop = ((Screen.Height / Screen.TwipsPerPixelY) / 2) - ((tRECT.Bottom - tRECT.Top) / 2)
                End If
                SetWindowPos hwnd, HWND_TOPMOST, lLeft, lTop, 0, 0, SWP_SHOWWINDOW Or SWP_NOSIZE
                Call Form1.DrawMyName
            ElseIf wParam = HOTKEY_CERRAR Then
                Unload Form1
                Exit Function
                
            End If
        Case WM_ACTIVATEAPP
            'ocutar
        
        
    End Select
    
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)

End Function

Public Sub SubClassForm(ByVal hwnd As Long)
    PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnSubClassForm(ByVal hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, PrevProc
End Sub


Public Function DrawGlowingText(ByVal hdc As Long, ByVal Text As String, tRECT As RECT, Optional lFlags As Long, Optional ByVal GlowSize As Long = 10) As Boolean
  
    Dim hTheme As Long
    Dim TempRect As RECT
    Dim hOldFont As Long
    Dim hBrush As Long
    Dim tDIB As BITMAPINFO
    Dim tDTO As DTTOPTS
    Dim hMemDC As Long
    Dim hDIB As Long
    Dim hOldBmp As Long
    
    hTheme = OpenThemeData(0&, StrPtr("TextStyle"))
    
    If hTheme > 0 Then
        With TempRect
            .Right = tRECT.Right + (GlowSize * 2)
            .Bottom = tRECT.Bottom + (GlowSize * 2)
        End With
  
        With tDIB.bmiHeader
            .biSize = Len(tDIB)
            .biWidth = TempRect.Right
            .biHeight = -TempRect.Bottom
            .biPlanes = 1
            .biBitCount = 32
            .biCompression = 0
        End With
  
        With tDTO
            .dwSize = Len(tDTO)
            .dwFlags = DTT_COMPOSITED Or DTT_GLOWSIZE Or DTT_TEXTCOLOR
            .iGlowSize = GlowSize
            .crText = GetTextColor(hdc)
        End With
        
        hMemDC = CreateCompatibleDC(hdc)
        hOldFont = SelectObject(hMemDC, GetCurrentObject(hdc, OBJ_FONT))

        hDIB = CreateDIBSection(hMemDC, tDIB, 0, 0, 0, 0)

        hOldBmp = SelectObject(hMemDC, hDIB)

        hBrush = CreateSolidBrush(GetBkColor(hdc))
        Call FillRect(hMemDC, TempRect, hBrush)
        DeleteObject hBrush
        
        TempRect.Left = GlowSize
        TempRect.Top = GlowSize
        TempRect.Right = tRECT.Right + GlowSize
        TempRect.Bottom = tRECT.Bottom + GlowSize

        Call DrawThemeTextEx(hTheme, hMemDC, 0, 0, StrPtr(Text), -1, lFlags, TempRect, tDTO)
        
        Call SelectObject(hMemDC, hOldFont)
        
        
        Call BitBlt(hdc, tRECT.Left - GlowSize, tRECT.Top - GlowSize, tRECT.Right + (GlowSize * 2), tRECT.Bottom + (GlowSize * 2), hMemDC, 0, 0, vbSrcCopy)
  
        Call SelectObject(hMemDC, hOldBmp)
        Call DeleteObject(hDIB)
        Call DeleteDC(hMemDC)
  
        Call CloseThemeData(hTheme)
        DrawGlowingText = True
    Else 'Win XP no necesitaria un buffer
        hTheme = OpenThemeData(0&, StrPtr("Window"))
        If hTheme Then
            tRECT.Right = tRECT.Right + tRECT.Left
            tRECT.Bottom = tRECT.Bottom + tRECT.Top
            DrawGlowingText = DrawThemeText(hTheme, hdc, 0, 0, StrPtr(Text), -1, lFlags, 0, tRECT) = 0
            Call CloseThemeData(hTheme)
        End If
    End If
    
End Function
