Wenn man beim SSTab-Control zur Laufzeit eine neue Registerkarte zwischen bereits bestehender Registerkarten einfügen möchte, hat man ein Problem... Mit unserem Tipp zeigen wir jedoch eine Möglichkeit auf, eine neue Registerkarte zwischen bereits bestehenden Registerkarten einzufügen. Fügen Sie nachfolgenden Code in ein Modul ein: Option Explicit ' zunächst die benötigten API-Deklarationen Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Long) As Long Private Declare Function GetClientRect Lib "user32" ( _ ByVal hwnd As Long, _ lpRect As cRECT) As Long Private Declare Function RedrawWindow Lib "user32" ( _ ByVal hwnd As Long, _ lprcUpdate As cRECT, _ ByVal hrgnUpdate As Long, _ ByVal fuRedraw As Long) As Long Private Const WM_SETREDRAW = &HB Private Const RDW_INVALIDATE = &H1 Private Const RDW_ALLCHILDREN = &H80 Private Const RDW_UPDATENOW = &H100 Private Const RDW_ERASE = &H4 Private Type cRECT left As Long top As Long right As Long bottom As Long End Type Private Type pControlOnTabPage oControl As Control lTabPage As Long bMove As Boolean End Type Haupt-Prozedur: ' Fügt eine TabPage einem SSTab-Control hinzu ' Parameter: ' oTabControl - Verweis auf SSTab ' lTabPage - Existierende TabPage ' sTabCaption - Caption des neuen Tabs ' bInsertBehind - True ::= nach lTabPage einfügen, False ::= vor lTabPage einfügen ' bAutoActivateTab - True ::= neu hinzugefügte TabPage wird aktiviert Public Sub AddTabPageToTabControl(ByRef oTabControl As SSTab, _ ByVal lTabPage As Long, _ Optional ByVal sTabCaption As String = "", _ Optional ByVal bInsertBehind As Boolean = True, _ Optional ByVal bAutoActivateTab As Boolean = True) ' Aktuell sichtbare TabPage Dim lAktTabPage As Long ' neue TabPage eines Controls Dim lNewControlTabPage As Long ' Aktuelle TabPage eines Controls Dim lAktControlTabPage As Long ' Hilfsobjekte Dim oTmpControl As Control Dim lCounter As Long With oTabControl ' Neuzeichnen deaktivieren LockWindow .hwnd, True ' aktuelle TabPage sichern lAktTabPage = .Tab ' Neue TabPage einfügen .Tabs = .Tabs + 1 ' Caption verschieben For lCounter = .Tabs - 2 To IIf(bInsertBehind, lTabPage + 1, lTabPage) Step -1 .TabCaption(lCounter + 1) = .TabCaption(lCounter) Next lCounter ' neue Bezeichnung einfügen .TabCaption(lCounter + 1) = sTabCaption ' Controls auf dem TabControl ggf. verschieben For Each oTmpControl In .Container ' auf welcher TabPage ist das Control ? lAktControlTabPage = GetTabNumberByControlName(oTabControl, oTmpControl, True, False) ' Ist das Control überhaupt auf einer TabPage ? If lAktControlTabPage > -1 Then ' neue TabPage ermitteln lNewControlTabPage = GetNewTabPageForControl(lAktControlTabPage, lTabPage, bInsertBehind) ' Ist alte von neuer verschieden ? If lNewControlTabPage <> lAktControlTabPage Then ' => dann verschieben With oTmpControl ' erst entfernen .Visible = False Set .Container = Me ' neue TabPage einstellen oTabControl.Tab = lNewControlTabPage ' und wieder hinzufügen Set .Container = oTabControl ' .Left-Eigenschaft korrigieren, falls noch "verschoben" If .left < 0 Then .left = .left + 74000 .Visible = True End With End If End If Next If bAutoActivateTab Then .Tab = IIf(bInsertBehind, lTabPage + 1, lTabPage) Else ' altes Tab wieder herstellen .Tab = lAktTabPage End If ' Neuzeichnen wieder einschalten LockWindow .hwnd, False End With End Sub Hilfsfunktionen: ' Sucht im SSTab nach der Registerkarte für ein bestimmten Control ' liefert -1, falls TabControl nicht Container des gesuchten Controls Public Function GetTabNumberByControlName(ByVal oTabControl As SSTab, _ ByVal vControl As Variant, _ Optional ByVal bAutoActivateTab As Boolean = True, _ Optional ByVal bLockWindow As Boolean = True) As Long Dim lCounter As Long Dim lTab As Long Dim oControl As Control Dim bFound As Boolean bFound = False With oTabControl ' alle Controls durchlaufen For Each oControl In .Container If IsObject(vControl) Then bFound = (oControl Is vControl) Else bFound = (oControl.Name = vControl) End If ' gefunden If bFound Then If Not oControl.Container Is oTabControl Then bFound = False Else Exit For End If End If Next If Not bFound Then ' das Control ist nicht im TabControl enthalten GetTabNumberByControlName = -1 Exit Function End If ' z.Zt. aktuelles Tab sichern lTab = .Tab ' Neuzeichnen deaktivieren If bLockWindow Then LockWindow .hwnd, True ' jetzt Registerkarte ausfindig machen For lCounter = 0 To .Tabs - 1 .Tab = lCounter If oControl.left > 0 Then ' Tab gefunden ... GetTabNumberByControlName = lCounter Exit For End If Next lCounter If Not bAutoActivateTab Then ' altes Tab wieder herstellen .Tab = lTab End If ' Neuzeichnen wieder einschalten If bLockWindow Then LockWindow .hwnd, False End With End Function ' Funktion errechnet nach Einfügen einer TabPage, ob ' alte TabPage nun verschoben ist Private Function GetNewTabPageForControl(ByVal lAktTabPage As Long, _ ByVal lNewTabPage As Long, _ ByVal bInsertBehind As Boolean) As Long ' Standardrückgabe GetNewTabPageForControl = lAktTabPage If lAktTabPage >= lNewTabPage Then If lAktTabPage = lNewTabPage Then ' nur verschieben wenn bInsertBehind = False If Not bInsertBehind Then Inc GetNewTabPageForControl End If Else ' größer => immer verschieben Inc GetNewTabPageForControl End If End If End Function ' Sub Incrementiert eine Long-Variable Private Sub Inc(ByRef lCounter As Long) lCounter = lCounter + 1 End Sub ' Neuzeichnen eines Fensters sperren Private Sub LockWindow(ByVal hwnd As Long, wLock As Boolean) Dim ClientRect As cRECT If wLock = True Then SendMessage hwnd, WM_SETREDRAW, False, 0& Else SendMessage hwnd, WM_SETREDRAW, True, 0& GetClientRect hwnd, ClientRect RedrawWindow hwnd, ClientRect, 0&, RDW_ERASE Or _ RDW_INVALIDATE Or RDW_ALLCHILDREN Or RDW_UPDATENOW End If End Sub Ein kleines Anwendungsbeispiel: ' neue Registerkarte nach der 1. Registerkarte einfügen AddTabPageToTabControl SSTab1, 0, "Neues Register" Dieser Tipp wurde bereits 12.057 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 April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 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. |