我有一个无法解决的特殊问题。我正在尝试制作一个完全透明的叠加层，但是，我必须能够将其单击成基础形式。这些重叠形式没有任何子项。每个叠加表单都包含一个面板。但是，如果不完全隐藏整个表单，我似乎无法获得所需的透明度。我该怎么办？
这是我的表单的代码。
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
答案 0 :(得分：0)
唯一的方法是使用UpdateLayeredWindow UpdateLayeredWindow 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)