VB無所不能之四：製作透明和半透明窗體

VB無所不能之四：製作透明和半透明窗體

 

——作者：鐘聲

博客地址：http://useway.blog.51cto.com

 

 

我們經常可以看到這樣的窗體，覺得很炫，如圖所示：

 

 

        同樣，對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

 

運行結果如下所示：

 

 

《 Java程序員，上班那點事兒 》, 前言 , 目錄

卓越網銷售鏈接
China-pub銷售鏈接
噹噹網銷售鏈接

《Java程序員，上班那點事》紀念帖