VB无所不能之四:制作透明和半透明窗体

本文介绍使用VB通过调用SetLayeredWindowAttributes函数创建透明及半透明窗体的方法。包括设置窗体透明度和制作异型窗体的具体步骤。
VB无所不能之四:制作透明和半透明窗体
 
——作者:钟声
 
 
我们经常可以看到这样的窗体,觉得很炫,如图所示:
 
 
        同样,对Windows系统方面的编程似乎首先想到的绝对不是VB,而大部分程序员想到的一定是VC。
         其实,VB对于这个实现非常方便且简单,用到了“user32”中的SetLayeredWindowAttributes()函数。
 
SetLayeredWindowAttributes()函数介绍:
函数声明:

Declare  Function SetLayeredWindowAttributes Lib  "user32" () 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的地方将变为透明
 
下面我们做两个实验:
 
第一个:做一个半透明窗体
 
步骤一:打开VB建立一个窗体Form
 
步骤二:将窗体背景颜色设为 :&HFF0000
 
步骤三:将下面代码粘贴到程序中:
 
Declare  Function GetWindowLong Lib  "user32" Alias  "GetWindowLongA" () Declare  Function GetWindowLong Lib  "user32" Alias  "GetWindowLongA" (ByVal hwnd  As Long, ByVal nIndex  As Long)  As Long 
Declare  Function SetWindowLong Lib  "user32" Alias  "SetWindowLongA" () Declare  Function SetWindowLong Lib  "user32" Alias  "SetWindowLongA" (ByVal hwnd  As Long, ByVal nIndex  As Long, ByVal dwNewLong  As Long)  As Long 
Declare  Function SetLayeredWindowAttributes Lib  "user32" () 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 
Const GWL_EXSTYLE = ()  Const GWL_EXSTYLE = (-20) 
Private  Const LWA_ALPHA = &H2 
Private  Const LWA_COLORKEY = &H1 

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, 100, LWA_ALPHA 
End  Sub
 
运行结果如下:
 
 
第一个:做一个异型窗体
 
在之前的窗体上放置一个图片如图所示:
 
 
将下面代码粘贴到程序中:
 
GetWindowLong Lib  "user32" Alias  "GetWindowLongA" () GetWindowLong Lib  "user32" Alias  "GetWindowLongA" ( GetWindowLong Lib  "user32" Alias  "GetWindowLongA" () GetWindowLong Lib  "user32" Alias  "GetWindowLongA" (ByVal hwnd  As Long, ByVal nIndex  As Long)  As Long    
SetWindowLong Lib  "user32" Alias  "SetWindowLongA" () SetWindowLong Lib  "user32" Alias  "SetWindowLongA" ( SetWindowLong Lib  "user32" Alias  "SetWindowLongA" () SetWindowLong Lib  "user32" Alias  "SetWindowLongA" (ByVal hwnd  As Long, ByVal nIndex  As Long, ByVal dwNewLong  As Long)  As Long    
SetLayeredWindowAttributes Lib  "user32" () SetLayeredWindowAttributes Lib  "user32" ( SetLayeredWindowAttributes Lib  "user32" () 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    
Const GWL_EXSTYLE = ()  Const GWL_EXSTYLE = (-20)    
Private  Const LWA_ALPHA = &H2    
Private  Const LWA_COLORKEY = &H1    

Sub Form_Load() 
         Dim rtn  As Long 
        BorderStyler = 0 
        rtn = GetWindowLong(hwnd, GWL_EXSTYLE) 
        rtn = rtn  Or WS_EX_LAYERED 
        SetWindowLong hwnd, GWL_EXSTYLE, rtn 
        SetLayeredWindowAttributes hwnd, &HFF0000, 0, LWA_COLORKEY                 '将扣去窗口中的蓝色 
End  Sub
 
运行结果如下所示:
 






 本文转自 useway 51CTO博客,原文链接:http://blog.51cto.com/useway/294579,如需转载请自行联系原作者

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值