用VB6.0在Vista下实现全磨砂玻璃窗口

然后运行(先确保系统使用Aero界面且合成效果被打开)，结果发现窗体依然如故。原来，DwmExtendFrameIntoClientArea扩展后的边框并不会在客户区的前景显示(它其实是一个背景，你会发现，此时边框其实已经被扩展了，因为原来的客户区的凹陷边界已经消失)，磨砂玻璃的效果被窗体默认画上去的前景覆盖了，所以我们得自己给窗体画个“透明”的前景。幸运的是，在RGB调色版中，黑色black (0x00000000)刚好就是ARGB(short for Alpha, Red, Green and Blue)的100%透明(这刚好可以解释为什么用Windows 画图板打开一个png图片时透明背景会变成纯黑)。所以，第一个方法，我们可以在窗口的Form_Paint事件(是的，Form_Paint就足够了，不用去子类化窗体。当然，如果要实现更高级功能，还是子类化吧…)中给窗口的前景用纯黑(RGB(0,0,0))填充，用的是经典的GDI，主要就是CreateSolidBrush和FillRect两个API工作，代码:

Dim hBrush As Long, m_Rect As RECT, hBrushOld As Long hBrush = CreateSolidBrush(RGB(0, 0, 0)) hBrushOld = SelectObject(Me.hdc, hBrush) GetClientRect Me.hwnd, m_Rect FillRect Me.hdc, m_Rect, hBrush SelectObject Me.hdc, hBrushOld DeleteObject hBrush ‘别忘了删除对象

　　现在再按一次F5，恩….很好!效果如下:

　　

　　但是接着问题就来了，当你在窗体上放上几个控件之后会发现，控件的黑色部分(一般就是文字)也带上了磨砂玻璃的“特效”，如图:

　　

　　注意到上面的Text1文字了吗?这种效果可不是我们想要的。怎么办呢?

　　上帝说:要有更好的办法

　　于是，就有了第二种实现方法。

　　其实这个问题的关键是画出透明的客户区，那么，别忘了，还有一个API可以做成此事，记得.NET里面那些控件和窗口有的有个TransparentKey属性么?没错了，就是用它—— SetLayeredWindowAttributes

　　SetLayeredWindowAttributes可以提供这样的一个功能:给一个窗口设定一个透明色，然后窗口显示的时候指定颜色的区域将变成透明。这样，只要我们给窗口指定一种没有用到的颜色(反正不是黑色就行，这里我用RGB(255,255,1))，就可以“画”出“透明”的区域了。

　　我们在使用之前要先对SetLayeredWindowAttributes做做手脚，将其声明为:

　　Public 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

　　为什么要这么干呢?留意函数第二个参数，本来有人将其声明为Byte类型(用于窗体半透明时没有问题)，但是这里要传一个RGB值，所以要改成Long

　　代码如下，相关的API和常量不再敷述，声明和值请读者自行补齐

　　Form_Load事件:(先声明m_transparencyKey全局变量，Long类型)

m_transparencyKey = RGB(255, 255, 1) ‘多少没所谓 SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED SetLayeredWindowAttributesByColor Me.hwnd, m_transparencyKey, 0, LWA_COLORKEY Dim mg As MARGINS, en As Long mg.m_Left = -1 mg.m_Button = -1 mg.m_Right = -1 mg.m_Top = -1 MsgBox "1" DwmIsCompositionEnabled en If en Then 　DwmExtendFrameIntoClientArea Me.hwnd, mg End If

　　再在Form_Paint事件中画图:

　　Form_Paint代码:

Dim hBrush As Long, m_Rect As RECT, hBrushOld As Long hBrush = CreateSolidBrush(m_transparencyKey) hBrushOld = SelectObject(Me.hdc, hBrush) GetClientRect Me.hwnd, m_Rect FillRect Me.hdc, m_Rect, hBrush SelectObject Me.hdc, hBrushOld DeleteObject hBrush

　　再按F5，效果嘛……

　　

　　顺便提一下，此代码在Windows Vista以下版本，2000及以上Windows版本运行时会产生一个很有趣的效果(除控件外窗体客户区背景完全透明!)，如图:

　　

查看本文来源