|
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
|
By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.
If a file you wish to view isn't highlighted, and is a text file (not binary), please
let us know and we'll add colourisation support for it.
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.