DWM API 的使用已经更新，请见：http://hi.baidu.com/micstudio/blog/item/29ec4cef245164ca2e2e21d3.html
比如：
'很好的代码，粘贴到窗体内即可使用
'缺点：直接使用 GDI+，导致 GDI 绘制的图像及文本出现不正常；在没有使用另外的某 DWM API 时（忘了……），窗口边框与客户区间还会有边界。
'Vista Home Premium 以下（不含）的系统不支持，请勿使用
'此源代码为从网上某处搜索得来，感谢原作者！
| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | 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）：
| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | 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 均可），这才是最终的解决方案。
相关声明嘛……啊我放在另一个模块里面了，比较乱，不复制了，网上都有。
