Примечание переводчика: Позже переведу статью, в которой более подробно рассказывается об этом коде.
Код портирован с С#.
Ссылка на скачивание архива.
Это всего лишь код на VB.NET, портированный с C#, о котором рассказывается в этой статье: Размещение объектов в Non-Client Area
Для того, чтобы использовать этот код, просто добавьте в свой проект два класса (Dwm.vb и WinApi.vb) из архива выше. Затем, в окно, в NC которого вы хотите разместить объект, добавьте следующий код:
Этот код сделает первые 15 пкс. вашего окна Client Area, и всё, что вы разместите на первых 15-20 пкс. вашего окна будет, якобы, находиться в "Non-Client Area", хотя на самом деле они будут расположены в Client Area.
Для большей информации, перейдите сюда: AeroNonClientAreaButtons.aspx.
Авторство оригинального кода остаётся за Jose Mendez; я всего лишь переписал этот код для пользователей VB.NET.
Код портирован с С#.
Ссылка на скачивание архива.
Вступление
Это всего лишь код на VB.NET, портированный с C#, о котором рассказывается в этой статье: Размещение объектов в Non-Client Area
Использование кода
Для того, чтобы использовать этот код, просто добавьте в свой проект два класса (Dwm.vb и WinApi.vb) из архива выше. Затем, в окно, в NC которого вы хотите разместить объект, добавьте следующий код:
Код
Imports WindowsApplication1.Dwm
Imports WindowsApplication1.WinApi
Imports WindowsApplication1.NcRender
Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Drawing.Drawing2D
Public Class Form1
#Region "Fields"
Private dwmMargins As Dwm.MARGINS
Private _marginOk As Boolean
Private _aeroEnabled As Boolean
#End Region
#Region "Ctor"
Public Sub New()
SetStyle(ControlStyles.ResizeRedraw, True)
InitializeComponent()
DoubleBuffered = True
CheckGlassEnabled()
End Sub
#End Region
#Region "Props"
Public ReadOnly Property AeroEnabled() As Boolean
Get
Return _aeroEnabled
End Get
End Property
#End Region
#Region "Methods"
''' <summary>
''' Sets the value of AeroEnabled
''' </summary>
Private Sub CheckGlassEnabled()
If Environment.OSVersion.Version.Major >= 6 Then
Dim enabled As Integer = 0
Dim response As Integer = Dwm.dwmIsCompositionEnabled(enabled)
_aeroEnabled = enabled = 1
End If
End Sub
''' <summary>
''' Equivalent to the LoWord C Macro
''' </summary>
''' <param name="dwValue"></param>
''' <returns></returns>
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
Private Sub Form1_Paint(ByVal sender As Object, _
ByVal e As System.Windows.Forms.PaintEventArgs) _
Handles Me.Paint
If _aeroEnabled Then
e.Graphics.Clear(Color.Transparent)
Else
e.Graphics.Clear(Color.FromArgb(&HC2, &HD9, &HF7))
End If
e.Graphics.FillRectangle(SystemBrushes.ButtonFace, _
Rectangle.FromLTRB(dwmMargins.cxLeftWidth - 0, _
dwmMargins.cyTopHeight - 0, _
Width - dwmMargins.cxRightWidth - 0, _
Height - dwmMargins.cyBottomHeight - 0))
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
dwmMargins.cyTopHeight = nccsp.rect2.Top - nccsp.rect1.Top
dwmMargins.cxLeftWidth = nccsp.rect2.Left - nccsp.rect1.Left
dwmMargins.cyBottomHeight = nccsp.rect1.Bottom - nccsp.rect2.Bottom
dwmMargins.cxRightWidth = nccsp.rect1.Right - nccsp.rect2.Right
_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
End Class
Этот код сделает первые 15 пкс. вашего окна Client Area, и всё, что вы разместите на первых 15-20 пкс. вашего окна будет, якобы, находиться в "Non-Client Area", хотя на самом деле они будут расположены в Client Area.
Для большей информации, перейдите сюда: AeroNonClientAreaButtons.aspx.
Авторство оригинального кода остаётся за Jose Mendez; я всего лишь переписал этот код для пользователей VB.NET.
Комментарии (6)
Evengard
25.11.2015 10:17Мне если честно даже интересней как подобное делают на тех же WinXP — видел я программы с подобным методом отрисовки и на WinXP, где API подобного нету.
devprodest
25.11.2015 10:38+1С таким же глубоким наполнением мысли статья могла бы выглядеть и в виде ссылки на оригинал
AlexandrDP
Еще на хабре не хватает статьи «Как передать параметр из одной формы в другую на VB.NET»
sdore
Благодарю. -_-