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）：

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 均可），这才是最终的解决方案。

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