Rubrik: Controls · Sonstiges | VB-Versionen: VB6 | 14.02.05 |
SSTab: Einfügen neuer Registerkarten zur Laufzeit Wenn man beim SSTab-Control zur Laufzeit eine neue Registerkarte zwischen bereits bestehender Registerkarten einfügen möchte, hat man ein Problem... | ||
Autor: Wolfgang Christ | Bewertung: | Views: 12.057 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Wenn man beim SSTab-Control zur Laufzeit eine neue Registerkarte zwischen bereits bestehender Registerkarten einfügen möchte, hat man ein Problem...
Denn das SSTab-Control erlaubt es lediglich eine neue Registerkarte ganz "hinten" anzufügen. Hierzu muss einfach nur die Tabs-Eigenschaft um den Wert 1 erhöht werden.
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:
Zur Laufzeit soll eine neue Registerkarte zwischen der 1. und der 2. bestehenden Registerkarte eingefügt werden.
' neue Registerkarte nach der 1. Registerkarte einfügen AddTabPageToTabControl SSTab1, 0, "Neues Register"