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! Dieser Tipp wurde bereits 19.086 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats Oktober 2024 Heinz Prelle Firewall-Status unter WinXP/Vista prüfen Das Beispiel prüft, ob die Firewall unter Windows XP/Vista eingeschaltet ist oder nicht. Zudem wird eine Abfrage durchgeführt ob es sich bei dem zugrundeliegenden Betriebssystem um Windows XP/Vista handelt oder nicht. sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||
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. |