Примечание переводчика: Позже переведу статью, в которой более подробно рассказывается об этом коде.

Код портирован с С#.



Ссылка на скачивание архива.

Вступление


Это всего лишь код на 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)


  1. AlexandrDP
    24.11.2015 22:34
    +11

    Еще на хабре не хватает статьи «Как передать параметр из одной формы в другую на VB.NET»


    1. sdore
      24.11.2015 22:43
      +1

      Благодарю. -_-


  1. Evengard
    25.11.2015 10:17

    Мне если честно даже интересней как подобное делают на тех же WinXP — видел я программы с подобным методом отрисовки и на WinXP, где API подобного нету.


    1. xRay
      26.11.2015 03:54

      Хадкор с Subclassing, WM_NCPAINT, GetWindowDC http://www.catch22.net/tuts/custom-titlebar
      Таким макаром не только кнопки туда засовывают, но и пргогресбар.


      1. sdore
        26.11.2015 20:56

        Уфф, не слабенько


  1. devprodest
    25.11.2015 10:38
    +1

    С таким же глубоким наполнением мысли статья могла бы выглядеть и в виде ссылки на оригинал