想问关于透明窗体但部分控件不透明的问题

Question

我在论坛里搜索了很多透明窗体的帖子 ，但看到的大部分都是全透的那种，连控件也透明了，我想让控件不透明可以办到吗？比如FORM里有个按钮 不让按钮透明，我尝试用那个颜色句柄，但没有成功，有高手指教下吗

Answer 1

SetLayeredWindowAttributes hwnd, &HFFFFFF, 0, LWA_COLORKEY          '将扣去窗口中的蓝色

Answer 2

  '或者Public Sub TransparentBlt(DstDC As Long, SrcDC As Long, ByVal SrcX As Integer, ByVal SrcY As Integer, ByVal SrcW As Integer, ByVal SrcH As Integer, DstX As Integer, DstY As Integer, transColor As Long)
    '     DstDC - Device context into image is actually drawn
    '     SrcDC - Device context of source to be made transparent in color TransColor
    '     SrcX, SrcY, SrcW, SrcH - Rectangular region of source bitmap in pixels
    '     DstX, DstY - Coordinates in OutDstDC where the transparent bitmap must go
    '     TransColor - Transparent color
    Dim nRet As Long
    Dim MonoMaskDC As Long, hMonoMask As Long
    Dim MonoInvDC As Long, hMonoInv As Long
    Dim ResultDstDC As Long, hResultDst As Long
    Dim ResultSrcDC As Long, hResultSrc As Long
    Dim hPrevMask As Long, hPrevInv As Long
    Dim hPrevSrc As Long, hPrevDst As Long
    Dim OldBC As Long
    Dim OldMode As Integer
           
    ' Create monochrome mask and inverse masks
    MonoMaskDC = CreateCompatibleDC(DstDC)
    MonoInvDC = CreateCompatibleDC(DstDC)
    ' Create monochrome bitmaps for the mask-related bitmaps:
    hMonoMask = CreateBitmap(SrcW, SrcH, 1, 1, ByVal 0&)
    hMonoInv = CreateBitmap(SrcW, SrcH, 1, 1, ByVal 0&)
    hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
    hPrevInv = SelectObject(MonoInvDC, hMonoInv)
    ' Create keeper DCs and bitmaps
    ResultDstDC = CreateCompatibleDC(DstDC)
    ResultSrcDC = CreateCompatibleDC(DstDC)
    'Create color bitmaps for final result & stored copy of source
    hResultDst = CreateCompatibleBitmap(DstDC, SrcW, SrcH)
    hResultSrc = CreateCompatibleBitmap(DstDC, SrcW, SrcH)
    hPrevDst = SelectObject(ResultDstDC, hResultDst)
    hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
    ' Copy src to monochrome mask
    OldBC = SetBkColor(SrcDC, transColor)
    nRet = BitBlt(MonoMaskDC, 0, 0, SrcW, SrcH, SrcDC, _
        SrcX, SrcY, vbSrcCopy)
    transColor = SetBkColor(SrcDC, OldBC)
    ' Create inverse of mask
    nRet = BitBlt(MonoInvDC, 0, 0, SrcW, SrcH, MonoMaskDC, _
        0, 0, vbNotSrcCopy)
    'Copy background bitmap to result & create final transparent bitmap
    nRet = BitBlt(ResultDstDC, 0, 0, SrcW, SrcH, DstDC, _
        DstX, DstY, vbSrcCopy)
     
    'AND mask bitmap w/ result DC to punch hole in the background by
    'painting black area for non-transparent portion of source bitmap.
    nRet = BitBlt(ResultDstDC, 0, 0, SrcW, SrcH, _
        MonoMaskDC, 0, 0, vbSrcAnd)
    ' Get overlapper
    nRet = BitBlt(ResultSrcDC, 0, 0, SrcW, SrcH, _
        SrcDC, SrcX, SrcY, vbSrcCopy)
    'AND inverse mask w/ source bitmap to turn off bits associated
    'with transparent area of source bitmap by making it black.
    nRet = BitBlt(ResultSrcDC, 0, 0, SrcW, SrcH, _
        MonoInvDC, 0, 0, vbSrcAnd)
    'XOR result w/ source bitmap to make background show through.
    nRet = BitBlt(ResultDstDC, 0, 0, SrcW, SrcH, _
        ResultSrcDC, 0, 0, vbSrcInvert)
    ' Output results
    nRet = BitBlt(DstDC, DstX, DstY, SrcW, SrcH, _
        ResultDstDC, 0, 0, vbSrcCopy)
    ' Clean up
    hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
    DeleteObject hMonoMask
    hMonoInv = SelectObject(MonoInvDC, hPrevInv)
    DeleteObject hMonoInv
    hResultDst = SelectObject(ResultDstDC, hPrevDst)
    DeleteObject hResultDst
    hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
    DeleteObject hResultSrc
    DeleteDC MonoMaskDC
    DeleteDC MonoInvDC
    DeleteDC ResultDstDC
    DeleteDC ResultSrcDC
End Sub

Answer 3

Public Sub DoTransparency(bg As PictureBox, transColor)
Dim rgn     As Long
Dim rgn2    As Long
Dim rgn3    As Long
Dim rgn4    As Long
Dim x1      As Long
Dim y1      As Long
Dim i       As Long
Dim j       As Long
Dim tj      As Long

bg.AutoRedraw = True

rgn = CreateRectRgn(0, 0, 0, 0)
rgn2 = CreateRectRgn(0, 0, 0, 0)
rgn3 = CreateRectRgn(0, 0, 0, 0)
i = 0
x1 = bg.Width '/ Screen.TwipsPerPixelX
y1 = bg.Height '/ Screen.TwipsPerPixelY
Do While i < x1
    j = 0
    Do While j < y1
        If GetPixel(bg.hdc, i, j) <> transColor Then
            tj = j
            Do While GetPixel(bg.hdc, i, j + 1) <> transColor
                j = j + 1
                If j = y1 Then Exit Do
            Loop
            rgn4 = CreateRectRgn(i, tj, i + 1, j + 1)

            CombineRgn rgn3, rgn2, rgn2, 5
            CombineRgn rgn2, rgn4, rgn3, 2

            DeleteObject rgn4
        End If
    j = j + 1
    Loop
    CombineRgn rgn3, rgn, rgn, 5
    CombineRgn rgn, rgn2, rgn3, 2
    i = i + 1
Loop
SetWindowRgn bg.hwnd, rgn, True
'清除
DeleteObject rgn
DeleteObject rgn2
DeleteObject rgn3End Sub

Answer 4

楼上的朋友，能否把代码贴到 [ c o d e = V B ][ / c o d e ] 块里呢~~看得眼花……………………