以下内容为程序代码:

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