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() 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() 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 運行結果如下所示: