如何让VB6窗体实现Win7的Areo透明效果
要做到的效果就像上面那张图里面的左边透明部分,麻烦高手们帮帮忙,请问VB6
要做到这样子的效果该要怎么在窗体声明里调用哪个API?请讲详细。 展开
先声明API和自定义类型:
Private Type RECT
Left As Long
Right As Long
Top As Long
Bottom As Long
End Type
Private Type BLURBEHIND
Flags As Long
Enable As Long
RGNBlur As Long
Transition As Long
End Type
Private Declare Function DwmExtendFrameIntoClientArea& Lib "dwmapi" (ByVal hwnd As Long, Margin As RECT)
Private Declare Function DwmEnableBlurBehindWindow& Lib "dwmapi" (ByVal hwnd As Long, Blur As BLURBEHIND)
Private Declare Function DwmEnableComposition& Lib "dwmapi" (ByVal Enabled As Boolean)
Private Declare Function DwmIsCompositionEnabled& Lib "dwmapi" (Enabled As Boolean)
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
通过isAero判断电脑是否支持Aero;如果支持那么执行Aero。
Private Sub Form_Load()
Dim sRT As RECT, sBlur As BLURBEHIND, isAero As Boolean
DwmIsCompositionEnabled isAero
If isAero Then
Me.BackColor = &H20304 '此处和窗体背景建议设置成不常用的颜色,此处使用&H020304,因为如果使用纯黑色,某些纯黑色的东西会透明看不见了
With sBlur
.Flags = 3
.Enable = 1
.RGNBlur = 0
End With
DwmEnableBlurBehindWindow Me.hwnd, sBlur
End If
End Sub
这样执行之后,发现窗体内部确实变成Aero效果了。这就是最基本的Aero效果。但是窗体内部的东西都被Aero了,看不清。这时你可以把DwmEnableBlurBehindWindow Me.hwnd, sBlur删掉,加上
Private Sub Command1_Click()
Dim sRT As RECT
Me.BackColor = &H020304
With sRT
.Left = Text1
.Right = Text2
.Top = Text3
.Bottom = Text4
End With
SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes Me.hwnd, &H20304, 0, LWA_COLORKEY '此处和窗体背景建议设置成不常用的颜色,此处使用&H020304,因为如果使用纯黑色,某些纯黑色的东西会透明看不见了
DwmExtendFrameIntoClientArea Me.hwnd, sRT
End Sub
修改Text1, 2, 3, 4的数值,窗体边缘的Aero便会延伸到客户区,而且里面的内容也可以看清。设置为-1可以整个窗体模糊化。
至于文字发光,这个还没会。
附:如果没有Aero,可能会这样
2013-08-12
' 我们调用GetWindowLong函数获取当前窗口的扩展属性,并调用SetWindowLong函数将新的WS_EX_LAYERED窗口扩展属性添加进去。
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Sub Form_Load()
Dim Rtn As Long
Rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
Rtn = Rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, Rtn
SetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHA
End Sub
函数SetLayeredWindowAttributes
使用这个函数,可以轻松的实现半透明窗体。按照微软的要求,透明窗体窗体在创建时应使用WS_EX_LAYERED参数(用CreateWindowEx),或者在创建后设置该参数(用SetWindowLong),我选用后者。全部函数、常量声明如下:
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
其中hwnd是透明窗体的句柄,crKey为颜色值,bAlpha是透明度,取值范围是[0,255],dwFlags是透明方式,可以取两个值:当取值为LWA_ALPHA时,crKey参数无效,bAlpha参数有效;当取值为LWA_COLORKEY时,bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明--这个功能很有用:我们不必再为建立不规则形状的窗体而调用一大堆区域分析、创建、合并函数了,只需指定透明处的颜色值即可,请看具体代码。
对于文字的问题 :
SetLayeredWindowAttributes有一个rbg值分别表示对三原色调 透明颜色,你可以把他们调节到透过窗体含量颜色高的RBG多点,字体和图形含的原色的少点 也许就能达到你想要的效果
我补充下吧:
基本上透明不规则图形也好,控件也好都是利用颜色或者切割组合运算的。SetLayeredWindowAttributes可以透过你指定颜色。要透过指定颜色必须把透明方式改为LWA_COLORKEY才有效。
参考:百科SetLayeredWindowAttributes
另种方法是 切割窗体。这种方法不适合变换图形
另外,可能你没有经过尝试,似乎在窗体上的按钮标签之类的控件,其文字的透明度是不受影响的。