Vista Aero 效果的纯 DWM API 实现，以及发光字 etc

DWM API 的使用已经更新，请见：http://hi.baidu.com/micstudio/blog/item/29ec4cef245164ca2e2e21d3.html
比如：

'很好的代码，粘贴到窗体内即可使用

'缺点：直接使用 GDI+，导致 GDI 绘制的图像及文本出现不正常；在没有使用另外的某 DWM API 时（忘了……），窗口边框与客户区间还会有边界。

'Vista Home Premium 以下（不含）的系统不支持，请勿使用

'此源代码为从网上某处搜索得来，感谢原作者！

Option Explicit 
    
Private Declare Function DwmIsCompositionEnabled Lib "dwmapi.dll" (ByRef enabledptr As Long) As Long
Private Declare Function DwmExtendFrameIntoClientArea Lib "dwmapi.dll" (ByVal hWnd As Long, margin As MARGINS) As Long
    
Private Type MARGINS 
  m_Left As Long
  m_Right As Long
  m_Top As Long
  m_Bottom As Long
End Type 
    
Private Declare Function DwmEnableBlurBehindWindow Lib "dwmapi" (ByVal hWnd As Long, pBlurBehind As DWM_BLURBEHIND) As Long
Private Declare Function DwmEnableComposition Lib "dwmapi" (ByVal bEnabled As Long) As Long
    
Private Const DWM_BB_ENABLE = &H1& 
Private Const DWM_BB_BLURREGION = &H2& 
Private Const DWM_BB_TRANSITIONONMAXIMIZED = &H4 
    
Private Type DWM_BLURBEHIND 
    dwFlags As Long
    fEnable As Long
    hRgnBlur As Long
    fTransitionOnMaximized As Long
End Type 
    
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    
Private Const LWA_COLORKEY = &H1 
Private Const WS_EX_LAYERED = &H80000 
Private Const GWL_EXSTYLE = (-20) 
    
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributesByColor Lib "user32" Alias "SetLayeredWindowAttributes" (ByVal hWnd As Long, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    
Private Type RECT 
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type 
    
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
    
Private Sub Form_Load() 
Dim m_transparencyKey  As Long
m_transparencyKey = 0 
SetWindowLong Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED 
SetLayeredWindowAttributesByColor Me.hWnd, &HC8C9CA, 0, LWA_COLORKEY 
Dim mg As MARGINS, en As Long
mg.m_Left = -1  
mg.m_Bottom = -1  
mg.m_Right = -1  
mg.m_Top = -1  
Dim R&, t&, bb As DWM_BLURBEHIND 
bb.dwFlags = DWM_BB_ENABLE Or DWM_BB_BLURREGION 
bb.fEnable = 1  
bb.hRgnBlur = 0  
bb.fTransitionOnMaximized = 1 
DwmEnableBlurBehindWindow hWnd, bb 
End Sub
    
Private Sub Form_Paint() 
Dim hBrush As Long, m_Rect As RECT, hBrushOld As Long
hBrush = CreateSolidBrush(&HC8C9CA) 
hBrushOld = SelectObject(Me.hdc, hBrush) 
GetClientRect Me.hWnd, m_Rect 
FillRect Me.hdc, m_Rect, hBrush 
SelectObject Me.hdc, hBrushOld 
DeleteObject hBrush 
End Sub

如果上面的代码在 VB .NET 中直接用 AllowTransparency 和 TransparencyKey 实现，则会得到完美玻璃化（无边框）的效果。

+新内容

以及自己根据资料写的一个函数，绘制发光文本（使用 VB .NET）：

Public Function DrawGlowingText(ByVal hDC As IntPtr, ByVal Text As String, ByVal Font As Font, ByVal Color As Color, ByVal Rect As Rectangle, ByVal GlowSize As Integer) As Integer
    Dim hTheme As Integer = OpenThemeData(GetDesktopWindow, "TextStyle") 
    If hTheme > 0 Then
        Dim dib As New BITMAPINFO 
        Dim dto As New DTTOPTS 
        Dim hMemDC As Integer = CreateCompatibleDC(hDC) 
   
        With dib.bmiHeader 
            .biSize = 40 
            .biWidth = Rect.Width * 40 
            .biHeight = -Rect.Height * Font.Size 
            .biPlanes = 1 
            .biBitCount = 32 
            .biCompression = BI_RGB 
        End With
   
        With dto 
            .dwSize = Len(dto) 
            .dwFlags = DTT_GLOWSIZE Or DTT_COMPOSITED Or DTT_TEXTCOLOR 
            .iGlowSize = GlowSize 
   
            .crText = ARGB2RGB(Color)    '注意，.NET 中以 ARGB 方式保存颜色信息，而 Windows Theme API 以 RGB 方式解读信息 
        End With
   
        Font = New Font(Font.FontFamily.Name, Font.Size) 
   
        Dim hDIB As Integer = CreateDIBSection(hDC, dib, DIB_RGB_COLORS, 0, 0, 0) 
        Dim hObjectOld As Integer = SelectObject(hMemDC, hDIB) 
        SelectObject(hMemDC, Font.ToHfont()) 
   
        Rect.X = Rect.X + GlowSize 
   
        DrawThemeTextEx(hTheme, hMemDC, 0, 0, Text, -1, 0, Rect, dto) 
        BitBlt(hDC, Rect.Top, Rect.Left, Rect.Width, Rect.Height, hMemDC, 0, 0, SRCCOPY) 
   
        SelectObject(hMemDC, hObjectOld) 
        'SetTextColor(hMemDC, intOldTextColor) 
        DeleteObject(hDIB) 
        DeleteDC(hMemDC) 
   
        CloseThemeData(hTheme) 
        Return 0 
    Else
        Return GetLastError() 
    End If
End Function

附：最好是使用相应 WM_PAINT 消息时将窗体整个用黑色画刷填充，然后再向上面绘制图片、文字（DrawThemeTextEx 或者 GraphicsPath 均可），这才是最终的解决方案。

相关声明嘛……啊我放在另一个模块里面了，比较乱，不复制了，网上都有。