VB制作透明控件。

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

然后 ，在FORM中调用即可实现！

private sub form_load()
UserControl11.Translucence
End sub