VB無所不能之四:製作透明和半透明表單

來源:互聯網
上載者:User
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 運行結果如下所示:  

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.