Toolstrip-Elemente in der Titelleiste Toolstrip-Buttons und andere Elemente in der Titelleiste anzeigen, wie bei Office 2007 Anwendungen
Autor:   Andreas Huhn	Bewertung:	Views:  18.837
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!

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.