以下无边框窗体阴影效果代码版主能否帮忙改写成狐表窗体可调用的 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以下内容为程序代码:

1 Imports System.Runtime.InteropServices
2 Imports System.Drawing.Drawing2D
3
4 Public Class ShadowForm
5 Inherits Form
6
7 Public isRoundShadow As Boolean = True
8 Public isShowShadow As Boolean = True
9 Private WithEvents _MainForm As Form
10 Private _ShadowWidth As Integer = 9
11 Private _ShadowImage As Bitmap
12
13 Public Property ShadowWidth As Integer
14 Get
15 Return _ShadowWidth
16 End Get
17 Set(value As Integer)
18 Me._ShadowWidth = value
19 ReSet()
20 End Set
21 End Property
22 Protected Overrides ReadOnly Property CreateParams As CreateParams
23 Get
24 Dim x As CreateParams = MyBase.CreateParams
25 x.ExStyle = x.ExStyle Or &H80000
26 Return x
27 End Get
28 End Property
29
30 Public Shared Function RegisterShadowForm(form As Form) As ShadowForm
31 Return New ShadowForm(form)
32 End Function
33 Private Sub New(form As Form)
34
35 ' 此调用是设计器所必需的。
36 'InitializeComponent()
37 Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
38
39 ' 在 InitializeComponent() 调用之后添加任何初始化。
40 _MainForm = form
41 InitMe()
42 End Sub
43
44 Private Sub InitMe()
45 _MainForm.Owner = Me
46 Me.ShowInTaskbar = False
47 End Sub
48
49 Public Sub SizeChange() Handles _MainForm.SizeChanged
50 ReSet()
51 End Sub
52 Public Sub LocationChange() Handles _MainForm.LocationChanged
53 Me.Location = New Point(_MainForm.Location.X - Me._ShadowWidth, _MainForm.Location.Y - Me._ShadowWidth)
54 End Sub
55 Private Sub ShowMe(sender As Object, e As EventArgs) Handles _MainForm.Shown
56 Me.Show()
57 ReSet()
58 End Sub
59
60
61 Private Sub ReSet()
62 If Me.isShowShadow Then
63 SetSizeLocation()
64 SetShadowImage()
65 setPaint()
66 End If
67 End Sub
68
69 Private Sub SetSizeLocation()
70 Me.Size = New Size(_MainForm.Size.Width + 2 * Me._ShadowWidth, _MainForm.Size.Height + 2 * Me._ShadowWidth)
71 Me.Location = New Point(_MainForm.Location.X - Me._ShadowWidth, _MainForm.Location.Y - Me._ShadowWidth)
72 End Sub
73 Private Function SetShadowImage() As Bitmap
74 If IsNothing(_ShadowImage) Then
75 _ShadowImage = New Bitmap(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width, System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height)
76 End If
77 Graphics.FromImage(_ShadowImage).Clear(Color.Transparent)
78 If isRoundShadow Then
79 _ShadowImage = SetRoundShadowStyle()
80 Else
81 _ShadowImage = SetShadowStyle()
82 End If
83 Return _ShadowImage
84 End Function
85 Private Function SetRoundShadowStyle()
86 '_ShadowImage = New Bitmap(Me.Width, Me.Height)
87 Dim g As Graphics = Graphics.FromImage(_ShadowImage)
88 g.SmoothingMode = SmoothingMode.HighQuality
89 Dim pen As Pen = New Pen(Color.FromArgb(0), 2)
90 For i As Integer = 0 To _ShadowWidth Step 1
91 pen.Color = Color.FromArgb((255 / 10 / _ShadowWidth) * i, 0, 0, 0)
92 g.DrawPath(pen, CreateRoundPath(New Rectangle(i, i, Me.Width - 2 * i - 1, Me.Height - 2 * i - 1)))
93 Next
94 Return _ShadowImage
95 End Function
96 Private Function CreateRoundPath(rect As Rectangle)
97 Dim cornerRadius As Integer = ShadowWidth * 0.6
98 Dim roundedRect As GraphicsPath = New GraphicsPath()
99 roundedRect.AddArc(rect.X, rect.Y, cornerRadius * 2, cornerRadius * 2, 180, 90)
100 roundedRect.AddLine(rect.X + cornerRadius, rect.Y, rect.Right - cornerRadius * 2, rect.Y)
101 roundedRect.AddArc(rect.X + rect.Width - cornerRadius * 2, rect.Y, cornerRadius * 2, cornerRadius * 2, 270, 90)
102 roundedRect.AddLine(rect.Right, rect.Y + cornerRadius * 2, rect.Right, rect.Y + rect.Height - cornerRadius * 2)
103 roundedRect.AddArc(rect.X + rect.Width - cornerRadius * 2, rect.Y + rect.Height - cornerRadius * 2, cornerRadius * 2, cornerRadius * 2, 0, 90)
104 roundedRect.AddLine(rect.Right - cornerRadius * 2, rect.Bottom, rect.X + cornerRadius * 2, rect.Bottom)
105 roundedRect.AddArc(rect.X, rect.Bottom - cornerRadius * 2, cornerRadius * 2, cornerRadius * 2, 90, 90)
106 roundedRect.AddLine(rect.X, rect.Bottom - cornerRadius * 2, rect.X, rect.Y + cornerRadius * 2)
107 roundedRect.CloseFigure()
108 Return roundedRect
109 End Function
110 Protected Overridable Function SetShadowStyle()
111 '_ShadowImage = New Bitmap(Me.Width, Me.Height)
112 Dim g As Graphics = Graphics.FromImage(_ShadowImage)
113
114 Dim pen As Pen = New Pen(Color.FromArgb(0), 2)
115 For i As Integer = 0 To _ShadowWidth Step 1
116 pen.Color = Color.FromArgb((255 / 10 / _ShadowWidth) * i, 0, 0, 0)
117 g.DrawRectangle(pen, New Rectangle(i, i, Me.Width - 2 * i - 1, Me.Height - 2 * i - 1))
118 Next
119 Return _ShadowImage
120 End Function
121
122 Private Sub setPaint()
123 Dim zero As IntPtr = IntPtr.Zero
124 Dim dc As IntPtr = GetDC(IntPtr.Zero)
125 Dim hgdiobj As IntPtr = IntPtr.Zero
126 Dim hdc As IntPtr = CreateCompatibleDC(dc)
127 Try
128 Dim pptdst As WinPoint = New WinPoint
129 pptdst.x = Me.Left
130 pptdst.y = Me.Top
131 Dim psize As WinSize = New WinSize With {.cx = Me.Width, .cy = Me.Height}
132 Dim pblend As BLENDFUNCTION = New BLENDFUNCTION()
133 Dim pprsrc As WinPoint = New WinPoint With {.x = 0, .y = 0}
134 hgdiobj = _ShadowImage.GetHbitmap(Color.FromArgb(0))
135 zero = SelectObject(hdc, hgdiobj)
136 pblend.BlendOp = 0
137 pblend.SourceConstantAlpha = Byte.Parse("255")
138 pblend.AlphaFormat = 1
139 pblend.BlendFlags = 0
140 If Not UpdateLayeredWindow(MyBase.Handle, dc, pptdst, psize, hdc, pprsrc, 0, pblend, 2) Then
141 Dim x = GetLastError()
142 End If
143 Return
144 Finally
145 If hgdiobj ＜＞ IntPtr.Zero Then
146 SelectObject(hdc, zero)
147 DeleteObject(hgdiobj)
148 End If
149 ReleaseDC(IntPtr.Zero, dc)
150 DeleteDC(hdc)
151 End Try
152 End Sub
153
154 ＜DllImport("gdi32.dll")＞
155 Private Shared Function DeleteDC(hdc As IntPtr) As Boolean
156
157 End Function
158 ＜DllImport("user32.dll")＞
159 Private Shared Function ReleaseDC(hwnd As IntPtr, hdc As IntPtr) As Integer
160
161 End Function
162 ＜DllImport("kernel32.dll")＞
163 Private Shared Function GetLastError() As Integer
164
165 End Function
166 ＜DllImport("user32.dll")＞
167 Private Shared Function UpdateLayeredWindow(hwnd As IntPtr, sdc As IntPtr, ByRef loc As WinPoint, ByRef size As WinSize, srcdc As IntPtr, ByRef sloc As WinPoint, c As Integer, ByRef bd As BLENDFUNCTION, x As Integer) As Integer
168
169 End Function
170 ＜DllImport("gdi32.dll")＞
171 Private Shared Function CreateCompatibleDC(intptr As IntPtr) As IntPtr
172
173 End Function
174 ＜DllImport("user32.dll")＞
175 Private Shared Function GetDC(hwnd As IntPtr) As IntPtr
176
177 End Function
178 ＜DllImport("gdi32.dll")＞
179 Private Shared Function DeleteObject(hwnd As IntPtr) As Boolean
180
181 End Function
182 ＜DllImport("gdi32.dll")＞
183 Private Shared Function SelectObject(hwnd As IntPtr, obj As IntPtr) As Integer
184
185 End Function
186
187
188 Structure WinPoint
189 Dim x As Integer
190 Dim y As Integer
191 End Structure
192 Structure WinSize
193 Dim cx As Integer
194 Dim cy As Integer
195 End Structure
196
197 Structure BLENDFUNCTION
198 Dim BlendOp As Byte
199 Dim BlendFlags As Byte
200 Dim SourceConstantAlpha As Byte
201 Dim AlphaFormat As Byte
202 End Structure
203
204 End Class
205

[此贴子已经被作者于2018/11/21 11:09:01编辑过]

全局代码

Public Class ShadowForm
    Inherits windows.forms.Form

    Public isRoundShadow As Boolean = True
    Public isShowShadow As Boolean = True
    Private WithEvents _MainForm As windows.forms.Form
    Private _ShadowWidth As Integer = 9
    Private _ShadowImage As Bitmap

    Public Property ShadowWidth As Integer
        Get
            Return _ShadowWidth
        End Get
        Set(value As Integer)
            Me._ShadowWidth = value
            ReSet()
        End Set
    End Property
    Protected Overrides ReadOnly Property CreateParams As windows.forms.CreateParams
        Get
            Dim x As windows.forms.CreateParams = MyBase.CreateParams
            x.ExStyle = x.ExStyle Or &H80000
            Return x
        End Get
    End Property

    Public Shared Function RegisterShadowForm(form As windows.forms.Form) As ShadowForm
        Return New ShadowForm(form)
    End Function
    Private Sub New(form As windows.forms.Form)

        ' 此调用是设计器所必需的.
        'InitializeComponent()
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None

        ' 在 InitializeComponent() 调用之后添加任何初始化.
        _MainForm = form
        InitMe()
    End Sub

    Private Sub InitMe()
        _MainForm.Owner = Me
        Me.ShowInTaskbar = False
    End Sub

    Public Sub SizeChanged(sender As Object, e As System.EventArgs) Handles _MainForm.SizeChanged
        ReSet()
    End Sub
    Public Sub LocationChange(sender As Object, e As System.EventArgs) Handles _MainForm.LocationChanged
        Me.Location = New Point(_MainForm.Location.X - Me._ShadowWidth, _MainForm.Location.Y - Me._ShadowWidth)
    End Sub
    Private Sub ShowMe(sender As Object, e As EventArgs) Handles _MainForm.Shown
        Me.Show()
        ReSet()
    End Sub

    Public Sub ReSet()
        If Me.isShowShadow Then
            SetSizeLocation()
            SetShadowImage()
            setPaint()
        End If
    End Sub

    Private Sub SetSizeLocation()
        Me.Size = New Size(_MainForm.Size.Width + 2 * Me._ShadowWidth, _MainForm.Size.Height + 2 * Me._ShadowWidth)
        Me.Location = New Point(_MainForm.Location.X - Me._ShadowWidth, _MainForm.Location.Y - Me._ShadowWidth)
    End Sub
    Private Function SetShadowImage() As Bitmap
        If IsNothing(_ShadowImage) Then
            _ShadowImage = New Bitmap(System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width, System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height)
        End If
        Graphics.FromImage(_ShadowImage).Clear(Color.Transparent)
        If isRoundShadow Then
            _ShadowImage = SetRoundShadowStyle()
        Else
            _ShadowImage = SetShadowStyle()
        End If
        Return _ShadowImage
    End Function
    Private Function SetRoundShadowStyle()
        '_ShadowImage = New Bitmap(Me.Width, Me.Height)
        Dim g As Graphics = Graphics.FromImage(_ShadowImage)
        g.SmoothingMode = SmoothingMode.HighQuality
        Dim pen As Pen = New Pen(Color.FromArgb(0), 2)
        For i As Integer = 0 To _ShadowWidth Step 1
            pen.Color = Color.FromArgb((255 / 10 / _ShadowWidth) * i, 0, 0, 0)
            g.DrawPath(pen, CreateRoundPath(New Rectangle(i, i, Me.Width - 2 * i - 1, Me.Height - 2 * i - 1)))
        Next
        Return _ShadowImage
    End Function
    Private Function CreateRoundPath(rect As Rectangle)
        Dim cornerRadius As Integer = ShadowWidth * 0.6
        Dim roundedRect As GraphicsPath = New GraphicsPath()
        roundedRect.AddArc(rect.X, rect.Y, cornerRadius * 2, cornerRadius * 2, 180, 90)
        roundedRect.AddLine(rect.X + cornerRadius, rect.Y, rect.Right - cornerRadius * 2, rect.Y)
        roundedRect.AddArc(rect.X + rect.Width - cornerRadius * 2, rect.Y, cornerRadius * 2, cornerRadius * 2, 270, 90)
        roundedRect.AddLine(rect.Right, rect.Y + cornerRadius * 2, rect.Right, rect.Y + rect.Height - cornerRadius * 2)
        roundedRect.AddArc(rect.X + rect.Width - cornerRadius * 2, rect.Y + rect.Height - cornerRadius * 2, cornerRadius * 2, cornerRadius * 2, 0, 90)
        roundedRect.AddLine(rect.Right - cornerRadius * 2, rect.Bottom, rect.X + cornerRadius * 2, rect.Bottom)
        roundedRect.AddArc(rect.X, rect.Bottom - cornerRadius * 2, cornerRadius * 2, cornerRadius * 2, 90, 90)
        roundedRect.AddLine(rect.X, rect.Bottom - cornerRadius * 2, rect.X, rect.Y + cornerRadius * 2)
        roundedRect.CloseFigure()
        Return roundedRect
    End Function
    Protected Overridable Function SetShadowStyle()
        '_ShadowImage = New Bitmap(Me.Width, Me.Height)
        Dim g As Graphics = Graphics.FromImage(_ShadowImage)

        Dim pen As Pen = New Pen(Color.FromArgb(0), 2)
        For i As Integer = 0 To _ShadowWidth Step 1
            pen.Color = Color.FromArgb((255 / 10 / _ShadowWidth) * i, 0, 0, 0)
            g.DrawRectangle(pen, New Rectangle(i, i, Me.Width - 2 * i - 1, Me.Height - 2 * i - 1))
        Next
        Return _ShadowImage
    End Function

    Private Sub setPaint()
        Dim zero As IntPtr = IntPtr.Zero
        Dim dc As IntPtr = GetDC(IntPtr.Zero)
        Dim hgdiobj As IntPtr = IntPtr.Zero
        Dim hdc As IntPtr = CreateCompatibleDC(dc)
        Try
            Dim pptdst As WinPoint = New WinPoint
            pptdst.x = Me.Left
            pptdst.y = Me.Top
            Dim psize As WinSize = New WinSize
psize.cx = Me.Width
psize.cy = Me.Height
            Dim pblend As BLENDFUNCTION = New BLENDFUNCTION()
            Dim pprsrc As WinPoint = New WinPoint
pprsrc.x = 0
pprsrc.y = 0
            hgdiobj = _ShadowImage.GetHbitmap(Color.FromArgb(0))
            zero = SelectObject(hdc, hgdiobj)
            pblend.BlendOp = 0
            pblend.SourceConstantAlpha = Byte.Parse("255")
            pblend.AlphaFormat = 1
            pblend.BlendFlags = 0
            If Not UpdateLayeredWindow(MyBase.Handle, dc, pptdst, psize, hdc, pprsrc, 0, pblend, 2) Then
                Dim x = GetLastError()
            End If
            Return
        Finally
            If hgdiobj <> IntPtr.Zero Then
                SelectObject(hdc, zero)
                DeleteObject(hgdiobj)
            End If
            ReleaseDC(IntPtr.Zero, dc)
            DeleteDC(hdc)
        End Try
    End Sub

#Region "import dll"
    <DllImport("gdi32.dll")> _
    Private Shared Function DeleteDC(hdc As IntPtr) As Boolean

    End Function
    <DllImport("user32.dll")> _
    Private Shared Function ReleaseDC(hwnd As IntPtr, hdc As IntPtr) As Integer

    End Function
    <DllImport("kernel32.dll")> _
    Private Shared Function GetLastError() As Integer

    End Function
    <DllImport("user32.dll")> _
    Private Shared Function UpdateLayeredWindow(hwnd As IntPtr, sdc As IntPtr, ByRef loc As WinPoint, ByRef size As WinSize, srcdc As IntPtr, ByRef sloc As WinPoint, c As Integer, ByRef bd As BLENDFUNCTION, x As Integer) As Integer

    End Function
    <DllImport("gdi32.dll")> _
    Private Shared Function CreateCompatibleDC(intptr As IntPtr) As IntPtr

    End Function
    <DllImport("user32.dll")> _
    Private Shared Function GetDC(hwnd As IntPtr) As IntPtr

    End Function
    <DllImport("gdi32.dll")> _
    Private Shared Function DeleteObject(hwnd As IntPtr) As Boolean

    End Function
    <DllImport("gdi32.dll")> _
    Private Shared Function SelectObject(hwnd As IntPtr, obj As IntPtr) As Integer

    End Function
#End Region
#Region "WinStructure"

    Structure WinPoint
        Dim x As Integer
        Dim y As Integer
    End Structure
    Structure WinSize
        Dim cx As Integer
        Dim cy As Integer
    End Structure

    Structure BLENDFUNCTION
        Dim BlendOp As Byte
        Dim BlendFlags As Byte
        Dim SourceConstantAlpha As Byte
        Dim AlphaFormat As Byte
    End Structure
#End Region

End Class

调用代码

Dim f = Forms("窗口1")
f.show
Dim frm = ShadowForm.RegisterShadowForm(f.baseform)
frm.show
frm.reset
f.show

[此贴子已经被作者于2018/11/21 11:57:59编辑过]

主题：以下无边框窗体阴影效果代码版主能否帮忙改写成狐表窗体可调用的