Rubrik: Oberfläche · Fenster | VB-Versionen: VB2005, VB2008 | 06.04.09 |
Toolstrip-Elemente in der Titelleiste Toolstrip-Buttons und andere Elemente in der Titelleiste anzeigen, wie bei Office 2007 Anwendungen | ||
Autor: Andreas Huhn | Bewertung: | Views: 19.109 |
www.andreashuhn.de | System: Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Seit Word 2007 kennt man es... Buttons zum speichern oder für Rückgängig / Wiederherstellen Operationen in der Titelleiste der Form. Um dies für seine eigene Anwendung zu realisieren muß man ein wenig in die Trickkiste greifen und eigentliche Titelleiste durch eine eigene ersetzen.
Optisch sieht das dann z.B. so aus:
Zunächst einmal müssen wir eine neue Klasse zu unserem Windows.Forms-Projekt hinzufügen, ich nenne sie TSB.vb. Darin befindet sich der Code für zwei eigene Klassen, der Übersichtlichkeit halber in einzelne Region-Abschnitte aufgeteilt:
Option Explicit On Option Strict On Imports System.Runtime.InteropServices Imports System.Drawing.Drawing2D Public Class TSB
#Region "DWM" Public Class Dwm ' DLL-API-Importe <DllImport("dwmapi.dll")> _ Public Shared Function DwmDefWindowProc(ByVal hwnd As IntPtr, _ ByVal msg As Integer, _ ByVal wParam As IntPtr, _ ByVal lParam As IntPtr, _ <System.Runtime.InteropServices.Out()> ByRef result As IntPtr) As Integer End Function <DllImport("dwmapi.dll")> _ Public Shared Function DwmIsCompositionEnabled( _ ByRef pfEnabled As Integer) As Integer End Function <DllImport("dwmapi.dll")> _ Public Shared Function DwmExtendFrameIntoClientArea( _ ByVal hdc As IntPtr, _ ByRef marInset As MARGINS) As Integer End Function <StructLayout(LayoutKind.Sequential)> _ Public Structure MARGINS Public cxLeftWidth As Integer Public cxRightWidth As Integer Public cyTopHeight As Integer Public cyBottomHeight As Integer ' Konstruktur Public Sub New(ByVal Left As Integer, ByVal Right As Integer, _ ByVal Top As Integer, ByVal Bottom As Integer) Me.cxLeftWidth = Left Me.cxRightWidth = Right Me.cyTopHeight = Top Me.cyBottomHeight = Bottom End Sub End Structure End Class #End Region
#Region "NCARenderer" Public Class NCARenderer ' Subklasse des ToolStripProfessionalRenderers Inherits ToolStripProfessionalRenderer ' Überschreiben diverser Ereignisse des Basis-Renderers Protected Overrides Sub OnRenderToolStripBackground(ByVal e As ToolStripRenderEventArgs) If e.ToolStrip.IsDropDown Then MyBase.OnRenderToolStripBackground(e) Else e.Graphics.Clear(Color.Transparent) End If End Sub Protected Overrides Sub OnRenderToolStripBorder(ByVal e As ToolStripRenderEventArgs) If e.ToolStrip.IsDropDown Then MyBase.OnRenderToolStripBorder(e) End If End Sub Protected Overrides Sub OnRenderItemText(ByVal e As ToolStripItemTextRenderEventArgs) If e.ToolStrip.IsDropDown Then MyBase.OnRenderItemText(e) Else Dim path As New GraphicsPath() path.AddString(e.Text, e.TextFont.FontFamily, CInt(Fix(e.TextFont.Style)), _ e.TextFont.Size + 2, e.TextRectangle.Location, New StringFormat()) e.Graphics.SmoothingMode = SmoothingMode.HighQuality e.Graphics.FillPath(Brushes.Black, path) path.Dispose() End If End Sub Protected Overrides Sub OnRenderOverflowButtonBackground( _ ByVal e As ToolStripItemRenderEventArgs) If e.Item.Selected Then e.Graphics.Clear(Color.FromArgb(20, Color.Navy)) End If Dim r As Rectangle = Rectangle.Empty If e.Item.RightToLeft = RightToLeft.Yes Then r = New Rectangle(0, e.Item.Height - 8, 9, 5) Else r = New Rectangle(e.Item.Width - 12, e.Item.Height - 16, 9, 5) End If MyBase.DrawArrow(New ToolStripArrowRenderEventArgs(e.Graphics, e.Item, _ r, SystemColors.ControlText, ArrowDirection.Down)) e.Graphics.DrawLine(SystemPens.ControlText, CInt(Fix(r.Right - 7)), _ CInt(Fix(r.Y - 2)), CInt(Fix(r.Right - 3)), CInt(Fix(r.Y - 2))) End Sub End Class #End Region
' Strukturen zur Verwaltung von Größe / Position #Region "Struct" <StructLayout(LayoutKind.Sequential)> _ Public Structure RECT Public Left As Integer Public Top As Integer Public Right As Integer Public Bottom As Integer End Structure <StructLayout(LayoutKind.Sequential)> _ Public Structure SIZE_PARAMS Public rect0, rect1, rect2 As RECT Public lppos As IntPtr End Structure #End Region
End Class
Unserer Form1 fügen wir ein ToolStrip-Steuerelement mit dem Namen tsNCToolStrip ein. Hier können nach Bedarf Buttons und weitere ToolStrip-Elemente definiert, Bilder dafür festgelegt werden, etc.
Innerhalb der Hauptklasse der Form fügen wir folgenden Code ein, der die Aufgabe hat die Darstellung zu aktivieren und die Benutzerinteraktion zu ermöglichen:
Public Class Form1 #Region " TSB-Code " Private dwmMargins As TSB.Dwm.MARGINS Private _marginOk As Boolean Private _aeroEnabled As Boolean
' Konstruktor Public Sub New() SetStyle(ControlStyles.ResizeRedraw, True) InitializeComponent() tsNCToolStrip.Renderer = New TSB.NCARenderer() DoubleBuffered = True If Environment.OSVersion.Version.Major >= 6 Then Dim enabled As Integer = 0 Dim response As Integer = TSB.Dwm.DwmIsCompositionEnabled(enabled) _aeroEnabled = enabled = 1 End If End Sub
' Hilfsfunktionen zur Bestimmung der Betriebssystem-Version Public Shared Function LoWord(ByVal dwValue As Integer) As Integer Return dwValue And &HFFFF End Function Public Shared Function HiWord(ByVal dwValue As Integer) As Integer Return (dwValue >> 16) And &HFFFF End Function
' Reaktion auf Form-Ereignisse Private Sub Form1_Resize(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles Me.Resize tsNCToolStrip.MaximumSize = New Size(Width - 100 - tsNCToolStrip.Left, 0) End Sub Private Sub Form1_Activated(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles Me.Activated If dwmMargins.cyTopHeight < tsNCToolStrip.Bottom Then dwmMargins.cyTopHeight = tsNCToolStrip.Bottom End If TSB.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
' Abhören der Nachrichtenschleife des Fensters um auf Klicks zu reagieren Protected 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 = TSB.Dwm.DwmDefWindowProc(m.HWnd, m.Msg, _ m.WParam, m.LParam, result) If dwmHandled = 1 Then m.Result = result Return End If If m.Msg = WM_NCCALCSIZE AndAlso CInt(m.WParam) = 1 Then Dim nccsp As TSB.SIZE_PARAMS = _ CType(System.Runtime.InteropServices.Marshal.PtrToStructure( _ m.LParam, GetType(TSB.SIZE_PARAMS)), TSB.SIZE_PARAMS) nccsp.rect0.Top += 0 nccsp.rect0.Bottom += 0 nccsp.rect0.Left += 0 nccsp.rect0.Right += 0 If (Not _marginOk) Then 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 System.Runtime.InteropServices.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
' Hilfsfunktion um den geklickten Bereich zuzuordnen Private Function HitTestNCA(ByVal hwnd As IntPtr, ByVal wparam As IntPtr, _ ByVal lparam As IntPtr) As IntPtr Dim HTCLIENT As Integer = 1 Dim HTCAPTION As Integer = 2 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 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 Region
Um das Erscheinungsbild auch optisch an die Word 2007 Vorgabe anzupassen, nehmen wir im Load-Ereignis folgende Einstellungen vor:
Private Sub Form1_Load(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles MyBase.Load tsNCToolStrip.Location = New Point(9, 5) tsNCToolStrip.Dock = DockStyle.None tsNCToolStrip.GripStyle = ToolStripGripStyle.Hidden End Sub
Zu guter letzt noch ein einfaches, kleines Beispiel wie man auf das Klick-Ereignis der ToolStrip-Buttons reagieren kann:
Private Sub TSBbtn_Click(ByVal sender As Object, ByVal e As EventArgs) _ Handles btnNew.Click, btnOpen.Click, btnSave.Click, btnUndo.Click, btnRedo.Click MessageBox.Show(DirectCast(sender, ToolStripButton).Name) End Sub
Viel Erfolg und Spaß beim Einbau in die eigene Anwendung!