本程式碼演示半透明控制元件的實現過程。如果是自定義控制元件，實現起來非常簡單，如果是系統控制元件，則要複雜一些。如果系統控制元件支援屬主畫，跟自定義控制元件思路完全是一樣的，只不過程式碼是寫在子類化的過程裡。 

    先建一個標準EXE工程，然後新增一個使用者控制元件，把以下程式碼複製到控制元件程式碼中，再把此控制元件放置到Form1上。

Option Explicit Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long Private Const DT_SINGLELINE = &H20 Private Const DT_CENTER = &H1 Private Const DT_VCENTER = &H4 Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Const SW_SHOW = 5 Private Const SW_HIDE = 0 Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean Dim m_hMemDC As Long Dim m_hMemBmp As Long, m_hMemBmpPrev As Long Dim m_rcControl As RECT Private Sub UserControl_Initialize() UserControl.AutoRedraw = True UserControl.BackColor = vbRed m_hMemDC = CreateCompatibleDC(UserControl.hdc) End Sub Private Sub UserControl_Terminate() If m_hMemBmp <> 0 Then DeleteObject SelectObject(m_hMemDC, m_hMemBmpPrev) End If DeleteDC m_hMemDC End Sub Public Sub Translucence() Dim hdc As Long Dim tPt As POINTAPI '獲得控制元件當前位置和大小 ClientToScreen UserControl.hwnd, tPt ScreenToClient UserControl.ContainerHwnd, tPt Call GetClientRect(UserControl.hwnd, m_rcControl) OffsetRect m_rcControl, tPt.X, tPt.Y '建立一幅記憶體點陣圖 If m_hMemBmp <> 0 Then DeleteObject (SelectObject(m_hMemDC, m_hMemBmpPrev)) End If m_hMemBmp = CreateCompatibleBitmap(UserControl.hdc, m_rcControl.Right, m_rcControl.Bottom) m_hMemBmpPrev = SelectObject(m_hMemDC, m_hMemBmp) '隱藏控制元件 ShowWindow UserControl.hwnd, SW_HIDE DoEvents '儲存控制元件容器的影象到記憶體點陣圖中 Dim hDesktopDC As Long hDesktopDC = GetDC(UserControl.hwnd) BitBlt m_hMemDC, 0, 0, m_rcControl.Right, m_rcControl.Bottom, hDesktopDC, 0, 0, vbSrcCopy ReleaseDC 0, hDesktopDC '通過alpha效果進行半透明渲染 UserControl.AutoRedraw = True AlphaBlend m_hMemDC, 0, 0, m_rcControl.Right, m_rcControl.Bottom, UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, 5242880 UserControl.AutoRedraw = False '顯示控制元件 ShowWindow UserControl.hwnd, SW_SHOW '將渲染後的結果複製到控制元件中 BitBlt UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, m_hMemDC, 0, 0, vbSrcCopy End Sub Private Sub UserControl_Paint() BitBlt UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, m_hMemDC, 0, 0, vbSrcCopy End Sub

    在Form1的Form_Activate事件裡輸入以下程式碼：

Private Sub Form_Activate() Me.UserControl11.Translucence End Sub

    最後，你將看到一個粉紅色半透明的方塊，該方塊就是你所需要的半透明的控制元件。至於控制元件的其它功能，讀者可以自行擴充套件。