VB.NET中实现带Alpha通道PNG窗口半透明及阴影恢复方案求助

我在VB.NET程序中需要显示带Alpha通道的图片，实现窗口部分透明。已经完成自定义标题栏和按钮，但设置FormBorderStyle = None后，Windows移除了所有窗口装饰，包括阴影。我希望恢复阴影，同时让阴影区域成为窗口调整大小的触摸区域。

之前尝试用TransparencyKey属性，但会给所有Alpha值非0和255的像素生成难看的轮廓：

我期望实现的效果：

请问这是否可行？恳请提供帮助，谢谢！

解决方案 #

完全可行，你可以通过Windows DWM API添加窗口阴影，结合分层窗口实现Alpha通道透明（规避TransparencyKey的轮廓问题），再手动实现窗口大小调整的交互逻辑。

1. 用DWM API添加窗口阴影 #

首先在窗体代码中引入DWM相关API，调用接口开启系统级窗口阴影：

Imports System.Runtime.InteropServices

Public Class Form1
    ' DWM API 声明
    <DllImport("dwmapi.dll")>
    Private Shared Function DwmSetWindowAttribute(hWnd As IntPtr, dwAttribute As Integer, ByRef pvAttribute As Integer, cbAttribute As Integer) As Integer
    End Function

    Private Const DWMWA_NCRENDERING_POLICY As Integer = 2
    Private Const DWMNCRP_ENABLED As Integer = 2

    <DllImport("dwmapi.dll")>
    Private Shared Function DwmExtendFrameIntoClientArea(hWnd As IntPtr, ByRef pMarInset As MARGINS) As Integer
    End Function

    <StructLayout(LayoutKind.Sequential)>
    Private Structure MARGINS
        Public cxLeftWidth As Integer
        Public cxRightWidth As Integer
        Public cyTopHeight As Integer
        Public cyBottomHeight As Integer
    End Structure

    ' 窗体加载时启用阴影
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        ' 开启DWM渲染
        Dim policy As Integer = DWMNCRP_ENABLED
        DwmSetWindowAttribute(Me.Handle, DWMWA_NCRENDERING_POLICY, policy, Marshal.SizeOf(policy))

        ' 扩展客户区边框，让阴影正常显示
        Dim margins As MARGINS = New MARGINS()
        margins.cxLeftWidth = 1
        margins.cxRightWidth = 1
        margins.cyTopHeight = 1
        margins.cyBottomHeight = 1
        DwmExtendFrameIntoClientArea(Me.Handle, margins)
    End Sub

2. 实现Alpha通道透明（替代TransparencyKey） #

使用分层窗口API实现精确的Alpha通道透明，避免TransparencyKey的轮廓问题：

在上述代码中添加额外API声明，并修改窗体创建参数：

<DllImport("user32.dll")>
Private Shared Function SetLayeredWindowAttributes(hWnd As IntPtr, crKey As Integer, bAlpha As Byte, dwFlags As Integer) As Boolean
End Function

Private Const LWA_ALPHA As Integer = &H2
Private Const WS_EX_LAYERED As Integer = &H80000

' 设置窗体为分层窗口
Protected Overrides ReadOnly Property CreateParams() As CreateParams
    Get
        Dim cp As CreateParams = MyBase.CreateParams
        cp.ExStyle = cp.ExStyle Or WS_EX_LAYERED
        Return cp
    End Get
End Property

加载带Alpha通道的图片后，直接利用其透明信息：

' 加载带Alpha通道的PNG图片作为背景
Me.BackgroundImage = Image.FromFile("你的透明图片路径.png")
' 若需要整体调整透明度可调用此方法（图片本身带Alpha可省略）
SetLayeredWindowAttributes(Me.Handle, 0, 255, LWA_ALPHA)

3. 实现窗口边缘调整大小交互 #

因为FormBorderStyle = None，需要手动处理鼠标事件来模拟系统窗口的边缘拖拽：

添加状态变量并实现鼠标事件：

Private isResizing As Boolean = False
Private resizeEdge As String = ""
Private resizeMargin As Integer = 10 ' 触发调整的边缘像素范围

Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles MyBase.MouseDown
    If e.Button = MouseButtons.Left Then
        ' 判断鼠标所在边缘
        If e.X <= resizeMargin Then resizeEdge = "Left"
        If e.X >= Me.Width - resizeMargin Then resizeEdge = "Right"
        If e.Y <= resizeMargin Then resizeEdge &= "Top"
        If e.Y >= Me.Height - resizeMargin Then resizeEdge &= "Bottom"
        isResizing = resizeEdge <> ""
    End If
End Sub

Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles MyBase.MouseMove
    If isResizing Then
        ' 根据边缘调整窗口大小
        Select Case resizeEdge
            Case "Left"
                Me.Left += e.X : Me.Width -= e.X
            Case "Right"
                Me.Width = e.X
            Case "Top"
                Me.Top += e.Y : Me.Height -= e.Y
            Case "Bottom"
                Me.Height = e.Y
            Case "LeftTop"
                Me.Left += e.X : Me.Width -= e.X : Me.Top += e.Y : Me.Height -= e.Y
            Case "RightTop"
                Me.Width = e.X : Me.Top += e.Y : Me.Height -= e.Y
            Case "LeftBottom"
                Me.Left += e.X : Me.Width -= e.X : Me.Height = e.Y
            Case "RightBottom"
                Me.Width = e.X : Me.Height = e.Y
        End Select
    Else
        ' 动态切换鼠标光标提示
        Dim cursor As Cursor = Cursors.Default
        If e.X <= resizeMargin Or e.X >= Me.Width - resizeMargin Then
            cursor = If(e.Y <= resizeMargin Or e.Y >= Me.Height - resizeMargin, Cursors.SizeNWSE, Cursors.SizeWE)
        ElseIf e.Y <= resizeMargin Or e.Y >= Me.Height - resizeMargin Then
            cursor = Cursors.SizeNS
        End If
        Me.Cursor = cursor
    End If
End Sub

Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles MyBase.MouseUp
    isResizing = False
    resizeEdge = ""
    Me.Cursor = Cursors.Default
End Sub

注意事项 #

• 该方案支持Windows Vista及以上系统（DWM功能默认开启）
• 优先使用PNG格式图片保存Alpha通道信息
• 若自定义标题栏需要拖拽窗口，可参照上述逻辑添加标题栏区域的鼠标拖动代码

内容的提问来源于stack exchange，提问作者La Mayenne