CRÉER UN PROGRAMME QUI UTILISE WINDOWS AERO

'==========================================   début AERO===============================================
'Déclarations
Imports System.Runtime.InteropServices

Friend Class Form1

    Private _currentPage As Integer = 0

    Public Sub New()

        MyBase.New()
        InitializeComponent()




    End Sub
    'appel des API
    <DllImport("gdi32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function BitBlt(ByVal hdc As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As UInteger) As Boolean
    End Function

    <DllImport("gdi32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function CreateCompatibleDC(ByVal hDC As IntPtr) As IntPtr
    End Function

    <DllImport("gdi32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function CreateDIBSection(ByVal hdc As IntPtr, ByRef pbmi As BITMAPINFO, ByVal iUsage As UInteger, ByVal ppvBits As Integer, ByVal hSection As IntPtr, ByVal dwOffset As UInteger) As IntPtr
    End Function

    <DllImport("gdi32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function DeleteDC(ByVal hdc As IntPtr) As Boolean
    End Function

    <DllImport("gdi32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean
    End Function

    <DllImport("UxTheme.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function DrawThemeText(ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByVal text As String, ByVal iCharCount As Integer, ByVal dwFlags1 As Integer, ByVal dwFlags2 As Integer, ByRef pRect As RECT) As Integer
    End Function

    <DllImport("UxTheme.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function DrawThemeTextEx(ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByVal text As String, ByVal iCharCount As Integer, ByVal dwFlags As Integer, ByRef pRect As RECT, ByRef pOptions As DTTOPTS) As Integer
    End Function

    <DllImport("dwmapi.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function DwmExtendFrameIntoClientArea(ByVal hWnd As IntPtr, ByRef pMarinset As MARGINS) As Integer
    End Function

    <DllImport("dwmapi.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Sub DwmIsCompositionEnabled(ByRef enabledptr As Integer)
    End Sub

    <DllImport("user32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function GetDC(ByVal hdc As IntPtr) As IntPtr
    End Function

    <DllImport("user32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function ReleaseDC(ByVal hdc As IntPtr, ByVal state As Integer) As Integer
    End Function

    <DllImport("gdi32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function SaveDC(ByVal hdc As IntPtr) As Integer
    End Function

    <DllImport("gdi32.dll", CallingConvention:=CallingConvention.Winapi, CharSet:=CharSet.Auto)> _
    Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
    End Function

    Public Structure BITMAPINFO
        Public bmiHeader As BITMAPINFOHEADER
        Public bmiColors As RGBQUAD
    End Structure

    Public Structure BITMAPINFOHEADER
        Public biSize As Integer
        Public biWidth As Integer
        Public biHeight As Integer
        Public biPlanes As Short
        Public biBitCount As Short
        Public biCompression As Integer
        Public biSizeImage As Integer
        Public biXPelsPerMeter As Integer
        Public biYPelsPerMeter As Integer
        Public biClrUsed As Integer
        Public biClrImportant As Integer
    End Structure

    Public Structure DTTOPTS
        Public dwSize As UInteger
        Public dwFlags As UInteger
        Public crText As UInteger
        Public crBorder As UInteger
        Public crShadow As UInteger
        Public iTextShadowType As Integer
        Public ptShadowOffset As POINTAPI
        Public iBorderSize As Integer
        Public iFontPropId As Integer
        Public iColorPropId As Integer
        Public iStateId As Integer
        Public fApplyOverlay As Integer
        Public iGlowSize As Integer
        Public pfnDrawTextCallback As IntPtr
        Public lParam As Integer
    End Structure

    Public Structure MARGINS
        Public cxLeftWidth As Integer
        Public cxRightWidth As Integer
        Public cyTopHeight As Integer
        Public cyBottomHeight As Integer
    End Structure

    Public Structure POINTAPI
        Public x As Integer
        Public y As Integer
    End Structure

    Public Structure RECT
        Public left As Integer
        Public top As Integer
        Public right As Integer
        Public bottom As Integer
    End Structure

    Public Structure RGBQUAD
        Public rgbBlue As Byte
        Public rgbGreen As Byte
        Public rgbRed As Byte
        Public rgbReserved As Byte
    End Structure

    Public Structure SHELLEXECUTEINFO
        Dim cbSize As Integer
        Dim fMask As Integer
        Dim hwnd As Integer
        Dim lpVerb As String
        Dim lpFile As String
        Dim lpParameters As String
        Dim lpDirectory As String
        Dim nShow As Integer
        Dim hInstApp As Integer
        Dim lpIDList As Integer
        Dim lpClass As String
        Dim hkeyClass As Integer
        Dim dwHotKey As Integer
        Dim hIcon As Integer
        Dim hProcess As Integer
    End Structure

    Friend Const BI_RGB As Integer = 0
    Friend Const DIB_RGB_COLORS As Integer = 0
    Friend Const DT_CENTER As Integer = 1
    Friend Const DTT_COMPOSITED As Integer = CInt((1 << 13))
    Friend Const DTT_GLOWSIZE As Integer = CInt((1 << 11))
    Friend Const DT_NOPREFIX As Integer = 2048
    Friend Const DT_SINGLELINE As Integer = 32
    Friend Const DT_VCENTER As Integer = 4
    Friend Const SRCCOPY As Integer = 13369376
    Friend Const WM_DWMCOMPOSITIONCHANGED As Integer = 798

    Public Sub DrawTextOnGlass(ByVal handle As IntPtr, ByVal text As String, ByVal font As Font, ByVal drawRectangle As Rectangle, ByVal glowSize As Integer)

        'Temporary variables
        Dim bitmap As IntPtr
        Dim bitmapOld As IntPtr = IntPtr.Zero
        Dim destinationDC As IntPtr = GetDC(handle)
        Dim dib As New BITMAPINFO()
        Dim dttOpts As New DTTOPTS()
        Dim hFont As IntPtr = font.ToHfont()
        Dim logfnotOld As IntPtr
        Dim rectangle1 As New RECT()
        Dim rectangle2 As New RECT()
        Dim renderer As New System.Windows.Forms.VisualStyles.VisualStyleRenderer(System.Windows.Forms.VisualStyles.VisualStyleElement.Window.Caption.Active)
        Dim memoryDC As IntPtr = CreateCompatibleDC(destinationDC)
        Dim uFormat As Integer

        'Set-up positioning rectangles
        'erreur si aero n'est pas activé, laisser les panel noir

        With dib.bmiHeader
            .biHeight = -(rectangle1.bottom - rectangle1.top)
            .biWidth = rectangle1.right - rectangle1.left
            .biPlanes = 1
            .biSize = Marshal.SizeOf(GetType(BITMAPINFOHEADER))
            .biBitCount = 32
            .biCompression = BI_RGB
        End With
        If Not SaveDC(memoryDC) = 0 Then
            bitmap = CreateDIBSection(memoryDC, dib, DIB_RGB_COLORS, 0, IntPtr.Zero, 0)
            If Not bitmap = IntPtr.Zero Then
                bitmapOld = SelectObject(memoryDC, bitmap)
                logfnotOld = SelectObject(memoryDC, hFont)
                Try
                    With dttOpts
                        .dwSize = CUInt(CInt(Marshal.SizeOf(GetType(DTTOPTS))))
                        .dwFlags = DTT_COMPOSITED Or DTT_GLOWSIZE
                        .iGlowSize = glowSize
                    End With
                    DrawThemeTextEx(renderer.Handle, memoryDC, 0, 0, text, -1, uFormat, rectangle2, dttOpts)
                    BitBlt(destinationDC, rectangle1.left, rectangle1.top, rectangle1.right - rectangle1.left, rectangle1.bottom - rectangle1.top, memoryDC, 0, 0, SRCCOPY)
                Catch exception As Exception
                    MessageBox.Show(exception.Message, "Erreur D'interface Graphique", MessageBoxButtons.OK, MessageBoxIcon.Error)
                End Try

                'Unload objects
                SelectObject(memoryDC, bitmapOld)
                SelectObject(memoryDC, logfnotOld)
                DeleteObject(bitmap)
                DeleteObject(hFont)
                ReleaseDC(memoryDC, -1)
                DeleteDC(memoryDC)

            End If
        End If

    End Sub

    Friend Function IsWindowsAeroEnabled() As Boolean

        Dim compositionEnabled As Integer = 0
        DwmIsCompositionEnabled(compositionEnabled)
        If compositionEnabled > 0 Then
            Return True
        Else
            Return False
        End If

    End Function

    Private Sub MakeWindowGlass(ByVal hWnd As IntPtr, ByVal leftMargin As Integer, ByVal rightMargin As Integer, ByVal topMargin As Integer, ByVal bottomMargin As Integer)

        Dim margins As New MARGINS
        With margins
            .cxLeftWidth = leftMargin
            .cxRightWidth = rightMargin
            .cyTopHeight = topMargin
            .cyBottomHeight = bottomMargin
        End With
        DwmExtendFrameIntoClientArea(hWnd, margins)

    End Sub
    'ici vous définnisez les longueurs en pixels de chaque bord de vôtre programme
    '60 GAUCHE 60 DROITE 60 HAUT 30 BAS
    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        If IsWindowsAeroEnabled() Then
            '=========================gauche- droite - haut  -bas
            MakeWindowGlass(Me.Handle, 60, 60, 60, 30)

        End If
        'les panel ( ou autre conteneur) doivent être obligatoirement NOIR

    End Sub
    '==========================================    fin de l'Interface AERO===============================================