Metro UI（ 类似 Zune） 界面（ 窗体）
如何在 VB.NET 中创建一个 Zune UI 无边框窗体
引言
Windows 界面的未来很可能就是 Zune 风格的界面，拥有无边框窗体和一些控件。问题是：如果你使用 WindowsForm，创建带有阴影和调整大小功能的无边框窗体并不像看起来那么容易。本文将向您展示如何使用一些 DWM 和其他 Windows API 来创建这些窗体。
背景
为了创建所需的效果，我们需要扩展非客户区，从窗口中移除 Aero 的玻璃效果，并处理一些调整大小和移动事件。幸运的是，José Mendez 在他的文章中向我们展示了如何做到这些事情。
当然，“非客户区技巧”仅在 Aero 开启时有效。但我在我的代码中处理了它。让我们来看看
Using the Code
我试图创建一个您可以继承的窗体，以便您可以轻松地使用我的代码。不幸的是，如果你想将该功能扩展到面板或其他控件中，必须更改大小调整功能。所以我更喜欢提供我的代码，以便您可以将其添加到您自己的窗体中。
另外，您需要拥有一个窗体文本并将 FormBorderStyle 属性设置为“Sizable”，才能使一切正常工作。如果 DWM 找不到窗体文本，就无法扩展玻璃效果和客户区，因此删除窗体的文本+控件框或将 FormBorderStyle 设置为除“Sizable”之外的任何其他值都会给您带来一些意想不到的错误。请记住这一点。
首先，您需要将 DWM.vb 和 WinApi.vb 两个类添加到您的项目中。然后，使用此代码使您的窗体具有 Zune (Metro) 风格的形状
#Region "Fields"
Private dwmMargins As Dwm.MARGINS
Private _marginOk As Boolean
Private _aeroEnabled As Boolean = False
#End Region
#Region "Ctor"
Public Sub New()
SetStyle(ControlStyles.ResizeRedraw, True)
InitializeComponent()
DoubleBuffered = True
End Sub
#End Region
#Region "Props"
Public ReadOnly Property AeroEnabled() As Boolean
Get
Return _aeroEnabled
End Get
End Property
#End Region
#Region "Methods"
Public Shared Function LoWord(ByVal dwValue As Integer) As Integer
Return dwValue And &HFFFF
End Function
''' <summary>
''' Equivalent to the HiWord C Macro
''' </summary>
''' <param name="dwValue"></param>
''' <returns></returns>
Public Shared Function HiWord(ByVal dwValue As Integer) As Integer
Return (dwValue >> 16) And &HFFFF
End Function
#End Region
Private Sub Form1_Activated(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles Me.Activated
Dwm.DwmExtendFrameIntoClientArea(Me.Handle, dwmMargins)
End Sub
Protected Overloads Overrides Sub WndProc(ByRef m As Message)
Dim WM_NCCALCSIZE As Integer = &H83
Dim WM_NCHITTEST As Integer = &H84
Dim result As IntPtr
Dim dwmHandled As Integer = Dwm.DwmDefWindowProc_
(m.HWnd, m.Msg, m.WParam, m.LParam, result)
If dwmHandled = 1 Then
m.Result = result
Exit Sub
End If
If m.Msg = WM_NCCALCSIZE AndAlso CInt(m.WParam) = 1 Then
Dim nccsp As NCCALCSIZE_PARAMS = _
DirectCast(Marshal.PtrToStructure(m.LParam, _
GetType(NCCALCSIZE_PARAMS)), NCCALCSIZE_PARAMS)
' Adjust (shrink) the client rectangle to accommodate the border:
nccsp.rect0.Top += 0
nccsp.rect0.Bottom += 0
nccsp.rect0.Left += 0
nccsp.rect0.Right += 0
If Not _marginOk Then
'Set what client area would be for passing to
'DwmExtendIntoClientArea. Also remember that at least
'one of these values NEEDS TO BE > 1, else it won't work.
dwmMargins.cyTopHeight = 0
dwmMargins.cxLeftWidth = 0
dwmMargins.cyBottomHeight = 1
dwmMargins.cxRightWidth = 0
_marginOk = True
End If
Marshal.StructureToPtr(nccsp, m.LParam, False)
m.Result = IntPtr.Zero
ElseIf m.Msg = WM_NCHITTEST AndAlso CInt(m.Result) = 0 Then
m.Result = HitTestNCA(m.HWnd, m.WParam, m.LParam)
Else
MyBase.WndProc(m)
End If
End Sub
Private Function HitTestNCA(ByVal hwnd As IntPtr, ByVal wparam _
As IntPtr, ByVal lparam As IntPtr) As IntPtr
Dim HTNOWHERE As Integer = 0
Dim HTCLIENT As Integer = 1
Dim HTCAPTION As Integer = 2
Dim HTGROWBOX As Integer = 4
Dim HTSIZE As Integer = HTGROWBOX
Dim HTMINBUTTON As Integer = 8
Dim HTMAXBUTTON As Integer = 9
Dim HTLEFT As Integer = 10
Dim HTRIGHT As Integer = 11
Dim HTTOP As Integer = 12
Dim HTTOPLEFT As Integer = 13
Dim HTTOPRIGHT As Integer = 14
Dim HTBOTTOM As Integer = 15
Dim HTBOTTOMLEFT As Integer = 16
Dim HTBOTTOMRIGHT As Integer = 17
Dim HTREDUCE As Integer = HTMINBUTTON
Dim HTZOOM As Integer = HTMAXBUTTON
Dim HTSIZEFIRST As Integer = HTLEFT
Dim HTSIZELAST As Integer = HTBOTTOMRIGHT
Dim p As New Point(LoWord(CInt(lparam)), HiWord(CInt(lparam)))
Dim topleft As Rectangle = RectangleToScreen(New Rectangle(0, 0, _
dwmMargins.cxLeftWidth, dwmMargins.cxLeftWidth))
If topleft.Contains(p) Then
Return New IntPtr(HTTOPLEFT)
End If
Dim topright As Rectangle = _
RectangleToScreen(New Rectangle(Width - dwmMargins.cxRightWidth, 0, _
dwmMargins.cxRightWidth, dwmMargins.cxRightWidth))
If topright.Contains(p) Then
Return New IntPtr(HTTOPRIGHT)
End If
Dim botleft As Rectangle = _
RectangleToScreen(New Rectangle(0, Height - dwmMargins.cyBottomHeight, _
dwmMargins.cxLeftWidth, dwmMargins.cyBottomHeight))
If botleft.Contains(p) Then
Return New IntPtr(HTBOTTOMLEFT)
End If
Dim botright As Rectangle = _
RectangleToScreen(New Rectangle(Width - dwmMargins.cxRightWidth, _
Height - dwmMargins.cyBottomHeight, _
dwmMargins.cxRightWidth, dwmMargins.cyBottomHeight))
If botright.Contains(p) Then
Return New IntPtr(HTBOTTOMRIGHT)
End If
Dim top As Rectangle = _
RectangleToScreen(New Rectangle(0, 0, Width, dwmMargins.cxLeftWidth))
If top.Contains(p) Then
Return New IntPtr(HTTOP)
End If
Dim cap As Rectangle = _
RectangleToScreen(New Rectangle(0, dwmMargins.cxLeftWidth, _
Width, dwmMargins.cyTopHeight - dwmMargins.cxLeftWidth))
If cap.Contains(p) Then
Return New IntPtr(HTCAPTION)
End If
Dim left As Rectangle = _
RectangleToScreen(New Rectangle(0, 0, dwmMargins.cxLeftWidth, Height))
If left.Contains(p) Then
Return New IntPtr(HTLEFT)
End If
Dim right As Rectangle = _
RectangleToScreen(New Rectangle(Width - dwmMargins.cxRightWidth, _
0, dwmMargins.cxRightWidth, Height))
If right.Contains(p) Then
Return New IntPtr(HTRIGHT)
End If
Dim bottom As Rectangle = _
RectangleToScreen(New Rectangle(0, Height - dwmMargins.cyBottomHeight, _
Width, dwmMargins.cyBottomHeight))
If bottom.Contains(p) Then
Return New IntPtr(HTBOTTOM)
End If
Return New IntPtr(HTCLIENT)
End Function
在
dwmMargins.cyTopHeight = 0
dwmMargins.cxLeftWidth = 0
dwmMargins.cyBottomHeight = 1
dwmMargins.cxRightWidth = 0
您至少需要有一个值大于 1。
现在您应该有类似这样的东西
太棒了！现在你有一个 Zune 风格的形状，带有阴影和所有东西。我们还需要什么？当然是调整大小功能！
Private Const BorderWidth As Integer = 6
Private _resizeDir As ResizeDirection = ResizeDirection.None
Private Sub Form1_MouseDown(ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
If Me.Width - BorderWidth > e.Location.X AndAlso _
e.Location.X > BorderWidth AndAlso e.Location.Y > BorderWidth Then
MoveControl(Me.Handle)
Else
If Me.WindowState <> FormWindowState.Maximized Then
ResizeForm(resizeDir)
End If
End If
End If
End Sub
Public Enum ResizeDirection
None = 0
Left = 1
TopLeft = 2
Top = 4
TopRight = 8
Right = 16
BottomRight = 32
Bottom = 64
BottomLeft = 128
End Enum
Private Property resizeDir() As ResizeDirection
Get
Return _resizeDir
End Get
Set(ByVal value As ResizeDirection)
_resizeDir = value
'Change cursor
Select Case value
Case ResizeDirection.Left
Me.Cursor = Cursors.SizeWE
Case ResizeDirection.Right
Me.Cursor = Cursors.SizeWE
Case ResizeDirection.Top
Me.Cursor = Cursors.SizeNS
Case ResizeDirection.Bottom
Me.Cursor = Cursors.SizeNS
Case ResizeDirection.BottomLeft
Me.Cursor = Cursors.SizeNESW
Case ResizeDirection.TopRight
Me.Cursor = Cursors.SizeNESW
Case ResizeDirection.BottomRight
Me.Cursor = Cursors.SizeNWSE
Case ResizeDirection.TopLeft
Me.Cursor = Cursors.SizeNWSE
Case Else
Me.Cursor = Cursors.Default
End Select
End Set
End Property
Private Sub Form1_MouseMove(ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
'Calculate which direction to resize based on mouse position
If e.Location.X < BorderWidth And e.Location.Y < BorderWidth Then
resizeDir = ResizeDirection.TopLeft
ElseIf e.Location.X < BorderWidth And e.Location.Y > Me.Height - BorderWidth Then
resizeDir = ResizeDirection.BottomLeft
ElseIf e.Location.X > Me.Width - BorderWidth And e.Location.Y > _
Me.Height - BorderWidth Then
resizeDir = ResizeDirection.BottomRight
ElseIf e.Location.X > Me.Width - BorderWidth And e.Location.Y < BorderWidth Then
resizeDir = ResizeDirection.TopRight
ElseIf e.Location.X < BorderWidth Then
resizeDir = ResizeDirection.Left
ElseIf e.Location.X > Me.Width - BorderWidth Then
resizeDir = ResizeDirection.Right
ElseIf e.Location.Y < BorderWidth Then
resizeDir = ResizeDirection.Top
ElseIf e.Location.Y > Me.Height - BorderWidth Then
resizeDir = ResizeDirection.Bottom
Else
resizeDir = ResizeDirection.None
End If
End Sub
Private Sub MoveControl(ByVal hWnd As IntPtr)
ReleaseCapture()
SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub
Private Sub ResizeForm(ByVal direction As ResizeDirection)
Dim dir As Integer = -1
Select Case direction
Case ResizeDirection.Left
dir = HTLEFT
Case ResizeDirection.TopLeft
dir = HTTOPLEFT
Case ResizeDirection.Top
dir = HTTOP
Case ResizeDirection.TopRight
dir = HTTOPRIGHT
Case ResizeDirection.Right
dir = HTRIGHT
Case ResizeDirection.BottomRight
dir = HTBOTTOMRIGHT
Case ResizeDirection.Bottom
dir = HTBOTTOM
Case ResizeDirection.BottomLeft
dir = HTBOTTOMLEFT
End Select
If dir <> -1 Then
ReleaseCapture()
SendMessage(Me.Handle, WM_NCLBUTTONDOWN, dir, 0)
End If
End Sub
<DllImport("user32.dll")> _
Public Shared Function ReleaseCapture() As Boolean
End Function
<DllImport("user32.dll")> _
Public Shared Function SendMessage(ByVal hWnd As IntPtr, _
ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) _
As Integer
End Function
Private Const WM_NCLBUTTONDOWN As Integer = &HA1
Private Const HTBORDER As Integer = 18
Private Const HTBOTTOM As Integer = 15
Private Const HTBOTTOMLEFT As Integer = 16
Private Const HTBOTTOMRIGHT As Integer = 17
Private Const HTCAPTION As Integer = 2
Private Const HTLEFT As Integer = 10
Private Const HTRIGHT As Integer = 11
Private Const HTTOP As Integer = 12
Private Const HTTOPLEFT As Integer = 13
Private Const HTTOPRIGHT As Integer = 14
很好，现在一切都应该正常工作了。 :D
啊，您还可以通过将“BorderWidth”值更改为您想要的任何值来增加和减少边框大小。只需记住它需要是一个整数值。
最后的问题
如果不覆盖任何边框，一切正常，但如果覆盖边框，则有一种简单的方法可以修复它。您所要做的就是将您的控件的 mousedown 和 mousemove 事件添加到 Form1_MouseDown 和 Form1_MouseMove 事件中。就这样。 :D
一点点工作...
通过多做一点工作和我的代码，您可以轻松创建功能齐全且令人惊叹的界面。最酷的部分是，现在您可以在您的窗体上创建一切！想要一个 Mac OS X 窗口？创建它！想要一个 Zune Clone 界面？复制它！就这么简单！ :D
我创建了一个简单的演示，展示了无需太多工作即可完成的工作（这只是一个预览，显示一些不同于黑色窗口的东西）。看看这个
这是 Zune 界面。
这只是一个简单的示例，展示了通过一点工作可以完成的工作。这只是我在 5 分钟内创建的一个示例应用程序，用于测试本文，正如您所看到的，它与 Zune UI 非常相似。
关注点
开发这种界面很酷，因为您可以完全控制您的窗体，而不会失去一些非常酷的 Vista/7 效果，例如阴影。
顺便说一句，我想为我糟糕的英语道歉。
和平。
历史
- 首次代码修订已发布