[VB9]Painel Ext com XP-Border Style e Gradient Color [Repositorio Codigo]

'************************************ 
'  Copyright(C)fLaSh - Carlos.DF
' [email protected]
'        10-21-2008
'************************************
Imports System
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.ComponentModel
Public Class urcPainelExt
    Inherits System.Windows.Forms.Panel

#Region "Component Designer generated code"

    <System.Diagnostics.DebuggerNonUserCode()> _
    Public Sub New(ByVal container As System.ComponentModel.IContainer)
        MyClass.New()

        'Required for Windows.Forms Class Composition Designer support
        If (container IsNot Nothing) Then
            container.Add(Me)
        End If

    End Sub

    <System.Diagnostics.DebuggerNonUserCode()> _
    Public Sub New()
        MyBase.New()

        'This call is required by the Component Designer.
        InitializeComponent()

    End Sub

    'Component overrides dispose to clean up the component list.
    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        Try
            If disposing AndAlso components IsNot Nothing Then
                components.Dispose()
            End If
        Finally
            MyBase.Dispose(disposing)
        End Try
    End Sub

    'Required by the Component Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Component Designer
    'It can be modified using the Component Designer.
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> _
    Private Sub InitializeComponent()
        components = New System.ComponentModel.Container()
        Me.BorderStyle = Windows.Forms.BorderStyle.Fixed3D
        Me.AutoScroll = True
    End Sub

#End Region

#Region " Paint FX "

    Private __EnableBCGradient As Boolean = True
    Private __GradColor1 As Color = Color.AliceBlue
    Private __GradColor2 As Color = Color.LightSteelBlue
    Private __GradMode As Drawing2D.LinearGradientMode = Drawing2D.LinearGradientMode.ForwardDiagonal
 
    <Category("Appearance"), Description("Start Gradient Color")> _
    Public Property GradColor1() As Color
        Get
            Return Me.__GradColor1
        End Get
        Set(ByVal value As Color)
            Me.__GradColor1 = value
            Me.Invalidate()
        End Set
    End Property

    <Category("Appearance"), Description("End Gradient Color")> _
    Public Property GradColor2() As Color
        Get
            Return Me.__GradColor2
        End Get
        Set(ByVal value As Color)
            Me.__GradColor2 = value
            Me.Invalidate()
        End Set
    End Property

    <Category("Appearance"), Description("Gradient Mode")> _
    Public Property GradMode() As System.Drawing.Drawing2D.LinearGradientMode
        Get
            Return Me.__GradMode
        End Get
        Set(ByVal value As System.Drawing.Drawing2D.LinearGradientMode)
            Me.__GradMode = value
            Me.Invalidate()
        End Set
    End Property

    <Category("Behavior"), Description("Enables or Disables Background Gradient")> _
    Public Property EnableBCGradient() As Boolean
        Get
            Return Me.__EnableBCGradient
        End Get
        Set(ByVal value As Boolean)
            Me.__EnableBCGradient = value
            Me.Invalidate()
        End Set
    End Property

    Private Sub urcPainelExt_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        MyBase.OnPaintBackground(e)
        If Me.__EnableBCGradient = False Then
            Return
        End If
        Dim rect As New Rectangle(0, 0, Me.Width, Me.Height)
        Dim lb As New System.Drawing.Drawing2D.LinearGradientBrush(rect, Me.__GradColor1, Me.__GradColor2, Me.__GradMode)
        e.Graphics.FillRectangle(lb, rect)
    End Sub

    Private Sub urcPainelExt_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        MyBase.Refresh()
    End Sub

#End Region

#Region " Border Style "

    ''' <summary>
    ''' Contains the size of the visual style borders
    ''' </summary>
    Private __BorderRect As NativeMethods.RECT
 
    Public Enum enBorderStyle As Short
        None = 0
        FixedSingle = 1
        Fixed3D = 2
        Flat = 3
    End Enum

    Private __BorderStyle As enBorderStyle
 
    <Category("Appearance"), Description("Select Border Style")> _
    Public Overloads Property BorderStyle() As enBorderStyle
        Get
            Return __BorderStyle
        End Get
        Set(ByVal value As enBorderStyle)
            __BorderStyle = value
            Me.Invalidate()
            Call UpDateVisualStyle()
        End Set
    End Property

    ''' <summary>
    ''' Filter some message we need to draw the border.
    ''' </summary>
    Protected Overloads Overrides Sub WndProc(ByRef m As Message)
        If RenderWithVisualStyles() Then
            Select Case m.Msg
                Case NativeMethods.WM_NCPAINT
                    ' the border painting is done here.
                    WmNcPaint(m)
                    Exit Select
                Case NativeMethods.WM_NCCALCSIZE
                    ' the size of the client area is calcuated here.
                    WmNcCalcSize(m)
                    Exit Select
                Case NativeMethods.WM_THEMECHANGED
                    ' Updates styles when the theme is changing.
                    UpdateStyles()
                    Exit Select
                Case Else
                    MyBase.WndProc(m)
                    Exit Select
            End Select
        Else
            MyBase.WndProc(m)
            Return
        End If
    End Sub

    ''' <summary>
    ''' Calculates the size of the window frame and client area of the Painel
    ''' </summary>
    Private Sub WmNcCalcSize(ByRef m As Message)

        ' let the control draw the scrollbar if necessary.
        MyBase.WndProc(m)

        ' we visual styles are not enabled and BorderStyle is not Fixed3D then we have nothing more to do.
        If Not Me.RenderWithVisualStyles() Then
            Return
        End If

        ' contains detailed information about WM_NCCALCSIZE message
        Dim oParams As New NativeMethods.NCCALCSIZE_PARAMS()

        ' contains the window frame RECT
        Dim oRect As NativeMethods.RECT

        'If m.WParam = IntPtr.Zero Then
        ' LParam points to a RECT struct
        oRect = DirectCast(Marshal.PtrToStructure(m.LParam, GetType(NativeMethods.RECT)), NativeMethods.RECT)

        ' contains the client area of the control
        Dim curRect As NativeMethods.RECT

        ' get the DC
        Dim hDC As IntPtr = NativeMethods.GetWindowDC(Me.Handle)

        ' open theme data
        Dim hTheme As IntPtr = NativeMethods.OpenThemeData(Me.Handle, "EDIT")

        ' find out how much space the borders needs
        If NativeMethods.GetThemeBackgroundContentRect(hTheme, hDC, NativeMethods.ETS_NORMAL, NativeMethods.ETS_NORMAL, oRect, curRect) = NativeMethods.S_OK Then
            ' shrink the client area the make more space for containing text.
            curRect.Inflate(-1, -1)

            ' remember the space of the borders
            Me.__BorderRect = New NativeMethods.RECT(curRect.Left - oRect.Left, curRect.Top - oRect.Top, oRect.Right - curRect.Right, oRect.Bottom - curRect.Bottom)

            ' update LParam of the message with the new client area
            If m.WParam = IntPtr.Zero Then
                Marshal.StructureToPtr(curRect, m.LParam, False)
            Else
                oParams.rgrc0 = curRect
                Marshal.StructureToPtr(oParams, m.LParam, False)
            End If

            ' force the control to redraw it´s client area
            m.Result = New IntPtr(NativeMethods.WVR_REDRAW)
        End If

        ' release theme data handle
        NativeMethods.CloseThemeData(hTheme)

        ' release DC
        NativeMethods.ReleaseDC(Me.Handle, hDC)
    End Sub

    ''' <summary>
    ''' The border painting is done here.
    ''' </summary>
    Private Sub WmNcPaint(ByRef m As Message)
        MyBase.WndProc(m)

        If Not Me.RenderWithVisualStyles() Then
            Return
        End If

        '**************************************************************************
        ' Get the DC of the window frame and paint the border using uxTheme API´s
        '**************************************************************************

        ' set the part id to Painel
        Dim partId As Integer = NativeMethods.ETS_NORMAL

        ' set the state id of the current Painel
        Dim stateId As Integer
        If Me.Enabled Then
            If Me.Enabled = False Then
                stateId = NativeMethods.ETS_READONLY
            Else
                stateId = NativeMethods.ETS_NORMAL
            End If
        Else
            stateId = NativeMethods.ETS_DISABLED
        End If

        ' define the windows frame rectangle of the Painel
        Dim windowRect As NativeMethods.RECT
        NativeMethods.GetWindowRect(Me.Handle, windowRect)
        windowRect.Right -= windowRect.Left
        windowRect.Bottom -= windowRect.Top
        windowRect.Top = InlineAssignHelper(windowRect.Left, 0)

        ' get the device context of the window frame
        Dim hDC As IntPtr = NativeMethods.GetWindowDC(Me.Handle)

        ' define a rectangle inside the borders and exclude it from the DC
        Dim clientRect As NativeMethods.RECT = windowRect
        clientRect.Left += Me.__BorderRect.Left
        clientRect.Top += Me.__BorderRect.Top
        clientRect.Right -= Me.__BorderRect.Right
        clientRect.Bottom -= Me.__BorderRect.Bottom
        NativeMethods.ExcludeClipRect(hDC, clientRect.Left, clientRect.Top, clientRect.Right, clientRect.Bottom)

        ' open theme data
        Dim hTheme As IntPtr = NativeMethods.OpenThemeData(Me.Handle, "EDIT")

        ' make sure the background is updated when transparent background is used.
        If NativeMethods.IsThemeBackgroundPartiallyTransparent(hTheme, NativeMethods.ETS_NORMAL, NativeMethods.ETS_NORMAL) <> 0 Then
            NativeMethods.DrawThemeParentBackground(Me.Handle, hDC, windowRect)
        End If

        ' draw background
        NativeMethods.DrawThemeBackground(hTheme, hDC, partId, stateId, windowRect, IntPtr.Zero)

        ' close theme data
        NativeMethods.CloseThemeData(hTheme)

        ' release dc
        NativeMethods.ReleaseDC(Me.Handle, hDC)

        ' we have processed the message so set the result to zero
        m.Result = IntPtr.Zero
    End Sub

    ''' <summary>
    ''' Returns true, when visual styles are enabled in this application.
    ''' </summary>
    Private Function VisualStylesEnabled() As Boolean
        ' Check if RenderWithVisualStyles property is available in the Application class (New feature in NET 2.0)
        Dim t As Type = GetType(Application)
        Dim pi As System.Reflection.PropertyInfo = t.GetProperty("RenderWithVisualStyles")

        If pi Is Nothing Then
            ' NET 1.1
            Dim os As OperatingSystem = System.Environment.OSVersion
            If os.Platform = PlatformID.Win32NT AndAlso (((os.Version.Major = 5) AndAlso (os.Version.Minor >= 1)) OrElse (os.Version.Major > 5)) Then
                Dim version As New NativeMethods.DLLVersionInfo()
                version.cbSize = Marshal.SizeOf(GetType(NativeMethods.DLLVersionInfo))
                If NativeMethods.DllGetVersion(version) = 0 Then
                    Return (version.dwMajorVersion > 5) AndAlso NativeMethods.IsThemeActive() AndAlso NativeMethods.IsAppThemed()
                End If
            End If

            Return False
        Else
            ' NET 2.0
            Dim result As Boolean = CBool(pi.GetValue(Nothing, Nothing))
            Return result
        End If
    End Function

    ''' <summary>
    ''' Return true, when this control should render with visual styles.
    ''' </summary>
    ''' <returns></returns>
    Private Function RenderWithVisualStyles() As Boolean
        Return CBool(__BorderStyle = enBorderStyle.Fixed3D AndAlso Me.VisualStylesEnabled)
    End Function

    ''' <summary>
    ''' Update the control parameters.
    ''' </summary>
    Protected Overloads Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim p As CreateParams = MyBase.CreateParams

            ' remove the Fixed3D border style
            If Me.RenderWithVisualStyles() AndAlso (p.ExStyle And NativeMethods.WS_EX_CLIENTEDGE) = NativeMethods.WS_EX_CLIENTEDGE Then
                p.ExStyle = p.ExStyle Xor NativeMethods.WS_EX_CLIENTEDGE
            End If

            Return p
        End Get
    End Property
    Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, ByVal value As T) As T
        target = value
        Return value
    End Function

    ''' <summary>
    ''' Update the control visual style.
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub UpDateVisualStyle()
        Select Case __BorderStyle
            Case enBorderStyle.None
                MyBase.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
                Me.Refresh()
                MyBase.BorderStyle = Windows.Forms.BorderStyle.None
            Case enBorderStyle.FixedSingle
                MyBase.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
            Case enBorderStyle.Fixed3D
                MyBase.BorderStyle = Windows.Forms.BorderStyle.Fixed3D
            Case enBorderStyle.Flat
                MyBase.BorderStyle = Windows.Forms.BorderStyle.None
                MakeFlatBorder(MyBase.Handle.ToInt32)
        End Select
        MyBase.Refresh()
    End Sub

#End Region

End Class

Friend NotInheritable Class NativeMethods
    Shared Sub New()
    End Sub

    ' API´s to get device context of the window frame
    <DllImport("user32.dll")> _
    Public Shared Function GetWindowDC(ByVal hWnd As IntPtr) As IntPtr
    End Function
    <DllImport("user32.dll")> _
    Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
    End Function
    <DllImport("user32.dll")> _
    Public Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
    End Function
    <DllImport("gdi32.dll")> _
    Public Shared Function ExcludeClipRect(ByVal hdc As IntPtr, ByVal nLeftRect As Integer, ByVal nTopRect As Integer, ByVal nRightRect As Integer, ByVal nBottomRect As Integer) As Integer
    End Function

    ' API´s for xp visual styles 
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure DLLVersionInfo
        Public cbSize As Integer
        Public dwMajorVersion As Integer
        Public dwMinorVersion As Integer
        Public dwBuildNumber As Integer
        Public dwPlatformID As Integer
    End Structure
    <DllImport("UxTheme.dll", CharSet:=CharSet.Auto)> _
    Public Shared Function IsAppThemed() As Boolean
    End Function
    <DllImport("UxTheme.dll", CharSet:=CharSet.Auto)> _
    Public Shared Function IsThemeActive() As Boolean
    End Function
    <DllImport("comctl32.dll", CharSet:=CharSet.Auto)> _
    Public Shared Function DllGetVersion(ByRef version As DLLVersionInfo) As Integer
    End Function
    <DllImport("uxtheme.dll", ExactSpelling:=True, CharSet:=CharSet.Unicode)> _
    Public Shared Function OpenThemeData(ByVal hWnd As IntPtr, ByVal classList As String) As IntPtr
    End Function
    <DllImport("uxtheme.dll", ExactSpelling:=True)> _
    Public Shared Function CloseThemeData(ByVal hTheme As IntPtr) As Int32
    End Function
    <DllImport("uxtheme", ExactSpelling:=True)> _
    Public Shared Function DrawThemeBackground(ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByRef pRect As RECT, ByVal pClipRect As IntPtr) As Int32
    End Function
    <DllImport("uxtheme", ExactSpelling:=True)> _
    Public Shared Function IsThemeBackgroundPartiallyTransparent(ByVal hTheme As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer) As Integer
    End Function
    <DllImport("uxtheme", ExactSpelling:=True)> _
    Public Shared Function GetThemeBackgroundContentRect(ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByRef pBoundingRect As RECT, ByRef pContentRect As RECT) As Int32
    End Function
    <DllImport("uxtheme", ExactSpelling:=True)> _
    Public Shared Function DrawThemeParentBackground(ByVal hWnd As IntPtr, ByVal hdc As IntPtr, ByRef pRect As RECT) As Int32
    End Function
    <DllImport("uxtheme", ExactSpelling:=True)> _
    Public Shared Function DrawThemeBackground(ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByRef pRect As RECT, ByRef pClipRect As RECT) As Int32
    End Function

    Public Const S_OK As Integer = &H0

    Public Const ETS_DISABLED As Integer = 4
    Public Const ETS_NORMAL As Integer = 1
    Public Const ETS_READONLY As Integer = 6

    Public Const WM_THEMECHANGED As Integer = &H31A
    Public Const WM_NCPAINT As Integer = &H85
    Public Const WM_NCCALCSIZE As Integer = &H83

    Public Const WS_EX_CLIENTEDGE As Integer = &H200
    Public Const WVR_HREDRAW As Integer = &H100
    Public Const WVR_VREDRAW As Integer = &H200
    Public Const WVR_REDRAW As Integer = (WVR_HREDRAW Or WVR_VREDRAW)

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure NCCALCSIZE_PARAMS
        Public rgrc0 As RECT, rgrc1 As RECT, rgrc2 As RECT
        Public lppos As IntPtr
    End Structure

    <Serializable(), StructLayout(LayoutKind.Sequential)> _
    Public Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
        Public Sub New(ByVal left_ As Integer, ByVal top_ As Integer, ByVal right_ As Integer, ByVal bottom_ As Integer)
            Left = left_
            Top = top_
            Right = right_
            Bottom = bottom_
        End Sub
        Public ReadOnly Property Height() As Integer
            Get
                Return Bottom - Top + 1
            End Get
        End Property
        Public ReadOnly Property Width() As Integer
            Get
                Return Right - Left + 1
            End Get
        End Property
        Public ReadOnly Property Size() As Size
            Get
                Return New Size(Width, Height)
            End Get
        End Property
        Public ReadOnly Property Location() As Point
            Get
                Return New Point(Left, Top)
            End Get
        End Property
        ' Handy method for converting to a System.Drawing.Rectangle
        Public Function ToRectangle() As Rectangle
            Return Rectangle.FromLTRB(Left, Top, Right, Bottom)
        End Function
        Public Shared Function FromRectangle(ByVal rectangle As Rectangle) As RECT
            Return New RECT(rectangle.Left, rectangle.Top, rectangle.Right, rectangle.Bottom)
        End Function
        Public Sub Inflate(ByVal width As Integer, ByVal height As Integer)
            Me.Left -= width
            Me.Top -= height
            Me.Right += width
            Me.Bottom += height
        End Sub
        Public Overloads Overrides Function GetHashCode() As Integer
            Return Left Xor ((Top << 13) Or (Top >> &H13)) Xor ((Width << &H1A) Or (Width >> 6)) Xor ((Height << 7) Or (Height >> &H19))
        End Function
#Region "Operator overloads"
        Public Shared Widening Operator CType(ByVal rect As RECT) As Rectangle
            Return Rectangle.FromLTRB(rect.Left, rect.Top, rect.Right, rect.Bottom)
        End Operator

        Public Shared Widening Operator CType(ByVal rect As Rectangle) As RECT
            Return New RECT(rect.Left, rect.Top, rect.Right, rect.Bottom)
        End Operator
#End Region
    End Structure
End Class