透明背景但可见图形

Question

我有一个无法解决的特殊问题。我正在尝试制作一个完全透明的叠加层，但是，我必须能够单击它进入底层表单。这些覆盖形式不属于任何东西。每个覆盖表单包含一个面板。但是，如果不完全使整个表单不可见，我似乎无法获得所需的透明度。我能做什么？

这是我的表单的代码。

Imports System.Runtime.InteropServices

Public Class frmOverlay

    Public ChartProperty As strChartProperty
    Private InitialStyle As Integer
    Dim PercentVisible As Decimal

    Public Sub New(ByRef chartProperties As strChartProperty)

        ' This call is required by the designer.
        InitializeComponent()
        ' Add any initialization after the InitializeComponent() call.
        ChartProperty = chartProperties
        SetStyle(ControlStyles.SupportsTransparentBackColor, True)
        BackColor = Color.Transparent
        ForeColor = Color.Transparent
        Opacity = 0
    End Sub

    Private Sub Form_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        InitialStyle = GetWindowLong(Me.Handle, -20)
        PercentVisible = 0.5
        SetWindowLong(Me.Handle, -20, InitialStyle Or &H80000 Or &H20)
        SetLayeredWindowAttributes(Me.Handle, 0, 255 * PercentVisible, &H2)
        Me.TopMost = True

        Dim panel As New OverlayPanel
        Controls.Add(panel)
    End Sub

    <DllImport("user32.dll", EntryPoint:="GetWindowLong")> Public Shared Function GetWindowLong(ByVal hWnd As IntPtr, ByVal nIndex As Integer) As Integer
    End Function

    <DllImport("user32.dll", EntryPoint:="SetWindowLong")> Public Shared Function SetWindowLong(ByVal hWnd As IntPtr, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
    End Function

    <DllImport("user32.dll", EntryPoint:="SetLayeredWindowAttributes")> Public Shared Function SetLayeredWindowAttributes(ByVal hWnd As IntPtr, ByVal crKey As Integer, ByVal alpha As Byte, ByVal dwFlags As Integer) As Boolean
    End Function

    Private Sub frmOverlay_ResizeEnd(sender As Object, e As EventArgs) Handles MyBase.ResizeEnd
        ResumeLayout()
    End Sub

    Private Sub frmOverlay_ResizeBegin(sender As Object, e As EventArgs) Handles MyBase.ResizeBegin
        SuspendLayout()
    End Sub

    Public Class OverlayPanel
        Inherits Panel

        Public Event Event_RedrawRequest(ByRef e As PaintEventArgs)

        Public Sub New()
            SetStyle(ControlStyles.DoubleBuffer Or ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint, True)
            UpdateStyles()
            Dock = DockStyle.Fill
        End Sub

        Protected Overrides Sub OnPaint(e As PaintEventArgs)
            Dim ChartProperty As strChartProperty = DirectCast(Me.Parent, frmOverlay).ChartProperty
            With e.Graphics
                .Clear(Me.Parent.BackColor)
                .SmoothingMode = IIf(ChartProperty.MaxDrawSpeed, Drawing2D.SmoothingMode.HighSpeed, Drawing2D.SmoothingMode.AntiAlias)
                .TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias '.ClearTypeGridFit
                .CompositingQuality = IIf(ChartProperty.MaxDrawSpeed, Drawing2D.CompositingQuality.HighSpeed, Drawing2D.CompositingQuality.HighQuality)
            End With

            MyBase.OnPaint(e)
            RaiseEvent Event_RedrawRequest(e)
            Debug.Print("Overlay had to paint")
        End Sub

    End Class

End Class

Answer 1

您可以做到这一点的唯一方法是使用UpdateLayeredWindowUpdateLayeredWindow function。此函数将 32 位位图设置为您的窗口窗体。在 windows 8 之后也可以用于子窗口：

Windows 8：顶级窗口和子窗口支持 WS_EX_LAYERED 样式。以前的 Windows 版本仅支持顶级窗口的 WS_EX_LAYERED。

使用此功能意味着您可以拥有一个完整的透明窗口并绘制图形但任何窗口或您所做的任何绘制都不可见！您必须对 32 位位图进行所有绘图并调用 UpdateLayeredWindow 以查看结果。如果您有多个子窗口，您确实会获得所有事件，但前提是鼠标位于非完整透明像素的顶部。一个小技巧是将alpha 设置为最低1，这样您就具有透明度，但也可以从您的窗口中获取所有事件。因为你想要一个点击槽形式没关系。现在代码：

创建一个类来保存您的所有 API

Public Class APIHelp

    Public Const WS_EX_LAYERED As Int32 = &H80000
    Public Const WS_EX_TRANSPARENT As Int32 = &H20
    Public Const ULW_ALPHA As Int32 = 2
    Public Const AC_SRC_OVER As Byte = 0
    Public Const AC_SRC_ALPHA As Byte = 1

    <StructLayout(LayoutKind.Sequential)>
    Public Structure Point
        Public x As Int32
        Public y As Int32

        Public Sub New(ByVal x As Int32, ByVal y As Int32)
            Me.x = x
            Me.y = y
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Public Structure Size
        Public cx As Int32
        Public cy As Int32

        Public Sub New(ByVal cx As Int32, ByVal cy As Int32)
            Me.cx = cx
            Me.cy = cy
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=1)>
    Private Structure ARGB
        Public Blue As Byte
        Public Green As Byte
        Public Red As Byte
        Public Alpha As Byte
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=1)>
    Public Structure BLENDFUNCTION
        Public BlendOp As Byte
        Public BlendFlags As Byte
        Public SourceConstantAlpha As Byte
        Public AlphaFormat As Byte
    End Structure

    Public Declare Auto Function UpdateLayeredWindow Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, ByVal hdcSrc As IntPtr, ByRef pprSrc As Point,
                      ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Bool

    Public Declare Auto Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As IntPtr) As IntPtr

    Public Declare Auto Function GetDC Lib "user32.dll" (ByVal hWnd As IntPtr) As IntPtr

    <DllImport("user32.dll", ExactSpelling:=True)>
    Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
    End Function

    Public Declare Auto Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Bool

    <DllImport("gdi32.dll", ExactSpelling:=True)>
    Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
    End Function
    Public Declare Auto Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Bool

    Public Declare Auto Function GetTickCount Lib "kernel32.dll" () As Double

    <DllImport("User32", SetLastError:=True)> Friend Shared Function ReleaseCapture() As Boolean
    End Function

End Class

调用这个函数来查看你的图形：

Public Sub UpdateLayeredBitmap(ByVal bitmap As Bitmap)
    'Does this bitmap contain an alpha channel?
    If bitmap.PixelFormat <> PixelFormat.Format32bppArgb Then
        Throw New ApplicationException("The bitmap must be 32bpp with alpha-channel.")
    End If

    'Get device contexts
    Dim screenDc As IntPtr = APIHelp.GetDC(IntPtr.Zero)
    Dim memDc As IntPtr = APIHelp.CreateCompatibleDC(screenDc)
    Dim hBitmap As IntPtr = IntPtr.Zero
    Dim hOldBitmap As IntPtr = IntPtr.Zero

    Try
        ' Get handle to the new bitmap and select it into the current device context
        hBitmap = bitmap.GetHbitmap(Color.FromArgb(0))
        hOldBitmap = APIHelp.SelectObject(memDc, hBitmap)

        Dim blend As APIHelp.BLENDFUNCTION = New APIHelp.BLENDFUNCTION()

        ' Only works with a 32bpp bitmap
        blend.BlendOp = APIHelp.AC_SRC_OVER
        ' Always 0
        blend.BlendFlags = 0
        ' Set to 255 for per-pixel alpha values
        blend.SourceConstantAlpha = 255
        ' Only works when the bitmap contains an alpha channel
        blend.AlphaFormat = APIHelp.AC_SRC_ALPHA

        Dim sourceLocation As New APIHelp.Point(0, 0)
        Dim newLocation As New APIHelp.Point(Me.Location.X, Me.Location.Y)
        Dim newSize As New APIHelp.Size(bitmap.Width, bitmap.Height)

        'Update the window
        APIHelp.UpdateLayeredWindow(Handle, IntPtr.Zero, newLocation, newSize, memDc, sourceLocation,
         0, Blend, APIHelp.ULW_ALPHA)
    Finally
        ' Release device context
        'APIHelp.ReleaseDC(IntPtr.Zero, screenDc)
        If hBitmap <> IntPtr.Zero Then
            APIHelp.SelectObject(memDc, hOldBitmap)
            ' Remove bitmap resources
            APIHelp.DeleteObject(hBitmap)
        End If
        APIHelp.DeleteDC(memDc)
        APIHelp.DeleteDC(screenDc)
    End Try
End Sub

将 ex 样式设置为您的表单：

Protected Overloads Overrides ReadOnly Property CreateParams() As CreateParams
    Get
        'Add the layered extended style (WS_EX_LAYERED) to this window
        Dim createParam As CreateParams = MyBase.CreateParams
        createParam.ExStyle = createParam.ExStyle Or APIHelp.WS_EX_LAYERED Or APIHelp.WS_EX_TRANSPARENT
        Return createParam
    End Get
End Property

举个例子，这是绘制图形的唯一方法：

Private backBitmapEmpty As Bitmap 'it is better to keep it private so to use it over and over

'create a 32 bit bitmap
backBitmapEmpty = New Bitmap(Me.Size.Width, Me.Size.Height, PixelFormat.Format32bppArgb)

Dim g As Graphics = Graphics.FromImage(backBitmapEmpty)

With g
    .SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
    .TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias '.ClearTypeGridFit
    .CompositingQuality = Drawing2D.CompositingQuality.HighQuality
End With

'make bitmap completely transparent
g.Clear(Color.FromArgb(0, 0, 0, 0))

g.DrawString("Some text", Me.Font, Brushes.Green, New PointF(150.0F, 150.0F))

g.Dispose()

'inform system that bitmap has changed
UpdateLayeredBitmap(backBitmapEmpty)