Tipp-Upload: VB.NET 0312: Vista Aero Glas für eigenes Fenster

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Fenster
• Grafik
• System

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Vista, Aero, Glas

Der Vorschlag wurde erstellt am: 09.09.2008 14:47.
Die letzte Aktualisierung erfolgte am 11.09.2008 02:31.

Zurück zur Übersicht

Beschreibung  

Den Aero Glas Effekt im eigenen Fenster ausweiten, so wie z.B. beim Windows Media Player.
Es stehen folgende Möglichkeiten zur Verfügung: • ganzes Fenster "verglasen" (wie beim WMP), • Dicke des Glasrandes für alle 4 Seiten individuell festlegen, • nur bestimmte Bereiche innerhalb des Fensters verglasen
Außerdem kann Aero systemweit aktiviert/deaktiviert werden.

Heinweis: Für den Fall, dass Aero deaktiviert ist, muss man für ein alternatives Rendering sorgen.

Wichtige Einstellungen, dass alles klappt: Anwendungsframework deaktivieren und über Sub Main starten, FlatStyle der Controls auf System umstellen, wenn selbstgeschriebene Texte in der OnPaint falsche Farbe haben evtl. ein TextRenderingHint=AntiAlias davor setzen.

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [18,82 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' -------- Anfang Projektgruppe Vista Glass Demo.sln  --------
' ------- Anfang Projektdatei Vista_Glass_Demo.vbproj  -------
' ---------------- Anfang Datei GlassForm.vb  ----------------
Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Text
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Drawing.Printing
Imports System.Drawing.Text

Partial Public Class GlassForm

    Private m_glassMargins As DwmApi.MARGINS

    Private Enum RenderMode
        None
        EntireWindow
        TopWindow
        Region
    End Enum

    Private m_RenderMode As RenderMode
    Private m_blurRegion As Region

    Public Sub New()

        InitializeComponent()
        m_RenderMode = RenderMode.None

    End Sub

    Protected Overloads Overrides Sub WndProc(ByRef msg As Message)

        MyBase.WndProc(msg)
        Const WM_DWMCOMPOSITIONCHANGED As Integer = 798
        Const WM_NCHITTEST As Integer = 132
        Const HTCLIENT As Integer = 1

        Select Case msg.Msg

            Case WM_NCHITTEST

                If HTCLIENT = msg.Result.ToInt32() Then

                    Dim p As New Point()

                    p.X = (msg.LParam.ToInt32() And 65535)
                    p.Y = (msg.LParam.ToInt32() >> 16)
                    p = PointToClient(p)

                    If PointIsOnGlass(p) Then
                        msg.Result = New IntPtr(2)
                    End If
                End If

                Exit Select

            Case WM_DWMCOMPOSITIONCHANGED

                If Not DwmApi.DwmIsCompositionEnabled() Then
                    m_RenderMode = RenderMode.None
                    m_glassMargins = Nothing

                    If m_blurRegion IsNot Nothing Then
                        m_blurRegion.Dispose()
                        m_blurRegion = Nothing
                    End If
                End If

                Exit Select

        End Select

    End Sub

    Private Function PointIsOnGlass(ByVal p As Point) As Boolean

        Return m_glassMargins IsNot Nothing AndAlso (m_glassMargins.cyTopHeight <= 0 OrElse _
            m_glassMargins.cyTopHeight > p.Y)

    End Function

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)

        ' Hier wird gemalt
        If DwmApi.DwmIsCompositionEnabled() Then

            ' Aero ist aktiviert
            Select Case m_RenderMode

                Case RenderMode.EntireWindow

                    ' ganzes Fenster
                    ' schwarz wird zu Glas!
                    e.Graphics.FillRectangle(Brushes.Black, Me.ClientRectangle)

                    Exit Select

                Case RenderMode.TopWindow

                    ' halbes Fenster
                    e.Graphics.FillRectangle(Brushes.Black, Rectangle.FromLTRB(0, 0, _
                        Me.ClientRectangle.Width, m_glassMargins.cyTopHeight))

                    Exit Select

                Case RenderMode.Region

                    ' Region
                    If m_blurRegion IsNot Nothing Then
                        e.Graphics.FillRegion(Brushes.Black, m_blurRegion)
                    End If

                    Exit Select

            End Select

            ' Text weiß machen, weil schwarz zu Glas werden würde
            Using textBrush As New SolidBrush(Color.FromArgb(255, 255, 255, 255))
                e.Graphics.TextRenderingHint = TextRenderingHint.SingleBitPerPixelGridFit
                e.Graphics.DrawString("This is writing on glass", Me.Font, textBrush, 10, 10)
            End Using

        Else

            ' Aero ist aus, alternatives Rendering erforderlich
            Using textBrush As New SolidBrush(Color.FromArgb(255, 0, 0, 0))
                e.Graphics.TextRenderingHint = TextRenderingHint.SingleBitPerPixelGridFit

                e.Graphics.DrawString("Aero ist aus, kann kein Glas machen!", Me.Font, _
                    textBrush, 10, 10)

            End Using

        End If

    End Sub

    Private Sub ResetDwmBlurBehind()

        If DwmApi.DwmIsCompositionEnabled() Then

            Dim bbhOff As New DwmApi.DWM_BLURBEHIND()

            bbhOff.dwFlags = DwmApi.DWM_BLURBEHIND.DWM_BB_ENABLE Or _
                DwmApi.DWM_BLURBEHIND.DWM_BB_BLURREGION

            bbhOff.fEnable = False
            bbhOff.hRegionBlur = IntPtr.Zero
            DwmApi.DwmEnableBlurBehindWindow(Me.Handle, bbhOff)
        End If

    End Sub

    Private Sub OnClientArea(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click

        ' ganzes Fenster mit Glas füllen
        ResetDwmBlurBehind()

        m_glassMargins = New DwmApi.MARGINS(-1, 0, 0, 0)
        m_RenderMode = RenderMode.EntireWindow

        If DwmApi.DwmIsCompositionEnabled() Then
            DwmApi.DwmExtendFrameIntoClientArea(Me.Handle, m_glassMargins)
        End If

        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.SizableToolWindow
        Me.Invalidate()

    End Sub

    Private Sub OnTopHalf(ByVal sender As Object, ByVal e As EventArgs) Handles Button2.Click

        ' halbes Fenster verglasen
        ResetDwmBlurBehind()

        m_glassMargins = New DwmApi.MARGINS(0, 150, 0, 0)
        m_RenderMode = RenderMode.TopWindow

        If DwmApi.DwmIsCompositionEnabled() Then
            DwmApi.DwmExtendFrameIntoClientArea(Me.Handle, m_glassMargins)
        End If

        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.SizableToolWindow

        Me.Invalidate()

    End Sub

    Private Sub OnGlassRegion(ByVal sender As Object, ByVal e As EventArgs) Handles Button3.Click

        ' Glasregion erstellen
        ResetDwmBlurBehind()

        m_glassMargins = New DwmApi.MARGINS(0, 0, 0, 0)
        m_RenderMode = RenderMode.Region

        If DwmApi.DwmIsCompositionEnabled() Then

            Using g As Graphics = CreateGraphics()
                DwmApi.DwmExtendFrameIntoClientArea(Me.Handle, m_glassMargins)

                If m_blurRegion IsNot Nothing Then
                    m_blurRegion.Dispose()
                End If

                m_blurRegion = New Region(New Rectangle(50, 10, Me.ClientRectangle.Width - _
                    100, 150))

                Dim bbh As New DwmApi.DWM_BLURBEHIND()

                bbh.dwFlags = DwmApi.DWM_BLURBEHIND.DWM_BB_ENABLE Or _
                    DwmApi.DWM_BLURBEHIND.DWM_BB_BLURREGION Or _
                    DwmApi.DWM_BLURBEHIND.DWM_BB_TRANSITIONONMAXIMIZED

                bbh.fEnable = True
                bbh.hRegionBlur = m_blurRegion.GetHrgn(g)
                bbh.fTransitionOnMaximized = False
                DwmApi.DwmEnableBlurBehindWindow(Me.Handle, bbh)
            End Using

        End If

        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.None

        Me.Invalidate()

    End Sub

    Private Sub CompositionCheckBox_CheckedChanged(ByVal sender As Object, ByVal e As _
        EventArgs) Handles CompositionCheckBox.CheckedChanged

        ' Aero systemweit ein-/ausschalten
        DwmApi.DwmEnableComposition(Not Me.CompositionCheckBox.Checked)
        Me.Invalidate()

    End Sub

End Class

' ----------------- Ende Datei GlassForm.vb  -----------------
' ------------------- Anfang Datei Main.vb -------------------
Module Main

    Sub Main()

        If Environment.OSVersion.Version.Major < 6 Then
            MsgBox("Sie haben kein Vista!")

            End
        End If

        Application.EnableVisualStyles()
        Application.SetCompatibleTextRenderingDefault(True)
        Application.Run(GlassForm)

    End Sub

End Module

' -------------------- Ende Datei Main.vb --------------------
' ----------------- Anfang Datei Win32Api.vb -----------------
Imports System.Runtime.InteropServices

Friend Class DwmApi

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Sub _
        DwmEnableBlurBehindWindow(ByVal hWnd As IntPtr, ByVal pBlurBehind As DWM_BLURBEHIND)

    End Sub

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Sub _
        DwmExtendFrameIntoClientArea(ByVal hWnd As IntPtr, ByVal pMargins As MARGINS)

    End Sub

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Function _
        DwmIsCompositionEnabled() As Boolean

    End Function

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Sub DwmGetColorizationColor( _
        ByRef pcrColorization As Integer, <MarshalAs(UnmanagedType.Bool)> ByRef pfOpaqueBlend _
        As Boolean)

    End Sub

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Sub DwmEnableComposition( _
        ByVal bEnable As Boolean)

    End Sub

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Function _
        DwmRegisterThumbnail(ByVal dest As IntPtr, ByVal source As IntPtr) As IntPtr

    End Function

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Sub DwmUnregisterThumbnail( _
        ByVal hThumbnail As IntPtr)

    End Sub

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Sub _
        DwmUpdateThumbnailProperties(ByVal hThumbnail As IntPtr, ByVal props As _
        DWM_THUMBNAIL_PROPERTIES)

    End Sub

    <DllImport("dwmapi.dll", PreserveSig:=False)> Public Shared Sub _
        DwmQueryThumbnailSourceSize(ByVal hThumbnail As IntPtr, ByRef size As Size)

    End Sub

    <StructLayout(LayoutKind.Sequential)> Public Class DWM_THUMBNAIL_PROPERTIES

        Public dwFlags As UInteger
        Public rcDestination As RECT
        Public rcSource As RECT
        Public opacity As Byte

        <MarshalAs(UnmanagedType.Bool)> Public fVisible As Boolean
        <MarshalAs(UnmanagedType.Bool)> Public fSourceClientAreaOnly As Boolean

        Public Const DWM_TNP_RECTDESTINATION As UInteger = 1
        Public Const DWM_TNP_RECTSOURCE As UInteger = 2
        Public Const DWM_TNP_OPACITY As UInteger = 4
        Public Const DWM_TNP_VISIBLE As UInteger = 8
        Public Const DWM_TNP_SOURCECLIENTAREAONLY As UInteger = 16

    End Class

    <StructLayout(LayoutKind.Sequential)> Public Class MARGINS

        Public cxLeftWidth As Integer, cxRightWidth As Integer, cyTopHeight As Integer, _
            cyBottomHeight As Integer

        Public Sub New(ByVal left As Integer, ByVal top As Integer, ByVal right As Integer, _
            ByVal bottom As Integer)

            cxLeftWidth = left
            cyTopHeight = top
            cxRightWidth = right
            cyBottomHeight = bottom

        End Sub

    End Class

    <StructLayout(LayoutKind.Sequential)> Public Class DWM_BLURBEHIND

        Public dwFlags As UInteger

        <MarshalAs(UnmanagedType.Bool)> Public fEnable As Boolean

        Public hRegionBlur As IntPtr

        <MarshalAs(UnmanagedType.Bool)> Public fTransitionOnMaximized As Boolean

        Public Const DWM_BB_ENABLE As UInteger = 1
        Public Const DWM_BB_BLURREGION As UInteger = 2
        Public Const DWM_BB_TRANSITIONONMAXIMIZED As UInteger = 4

    End Class

    <StructLayout(LayoutKind.Sequential)> Public Structure RECT

        Public left As Integer, top As Integer, right As Integer, bottom As Integer

        Public Sub New(ByVal left As Integer, ByVal top As Integer, ByVal right As Integer, _
            ByVal bottom As Integer)

            Me.left = left
            Me.top = top
            Me.right = right
            Me.bottom = bottom

        End Sub

    End Structure

End Class

' ------------------ Ende Datei Win32Api.vb ------------------
' -------- Ende Projektdatei Vista_Glass_Demo.vbproj  --------
' --------- Ende Projektgruppe Vista Glass Demo.sln  ---------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.