|
Die Buttons einer Toolbar aus den Microsoft Common Controls lassen sich nicht so einfach verschieben, da die Index-Eigenschaft eines Buttons leider schreibgeschützt ist. Es gibt offensichtlich keine andere Möglichkeit, als den zu verschiebenden Button aus der Toolbar heraus zu nehmen und an der gewünschten Position wieder einzufügen.
Vor dem Herausnehmen müssen Sie natürlich sämtliche Eigenschaften des Buttons auslesen, um den neu einzufügenden Button wieder mit eben diesen Eigenschaften versehen zu können. Dabei sollten Sie auch nicht vergessen, gegebenenfalls ein ButtonMenu (ab Version 6) auszulesen und anschließend wieder zu rekonstruieren.
Mittels der im Folgenden beschriebenen Prozeduren ToolbarButtonUp, ToolbarButtonDown und ToolbarButtonToIndex können Sie einen Button um eine Position nach vorne (oben), nach hinten (unten), an den Anfang oder ans Ende oder an eine beliebige Position verschieben. Der Vorgang des Auslesens und wieder Einlesens der Eigenschaften ist für alle drei Prozeduren gleich. Die eigentlichen Unterschiede bestehen lediglich bei der Festlegung der Index-Position vor dem Einfügen des neuen Buttons.
Bei der Funktion ToolbarButtonToIndex geben Sie im Parameter Index entweder die gewünschte neue Position an, oder den Wert 0, (oder die Konstante tbiToTop) um den Button an den Anfang, bzw. den Wert -1, (oder die Konstante tbiToBottom) um den Button ans Ende zu setzen.
Da der alte Button ja entfernt worden ist, wird die übergebene Referenz auf diesen durch eine Referenz auf den neuen Button ersetzt.
Public Enum ToolbarIndexConstants
tbiToTop = 0
tbiToBottom = -1
End Enum
Public Sub ToolbarButtonUp(Toolbar As Toolbar, Button As Button, _
Optional CallBackObject As Object)
Dim nIndex As Long
Dim nCaption As String
Dim nDescription As String
Dim nEnabled As Boolean
Dim nImage As String
Dim nKey As String
Dim nMixedState As String
Dim nStyle As ButtonStyleConstants
Dim nToolTipText As String
Dim nValue As ValueConstants
Dim nVisible As Boolean
Dim nWidth As Single
Dim nTag As Variant
Dim nButtonMenus As Collection
Dim nButtonMenu As ButtonMenu
Dim nButtonMenuVar As Variant
With Button
nIndex = .Index
If nIndex > 1 Then
nCaption = .Caption
nDescription = .Description
nEnabled = .Enabled
nImage = .Image
nKey = .Key
nMixedState = .MixedState
nStyle = .Style
nToolTipText = .ToolTipText
nValue = .Value
nVisible = .Visible
nWidth = .Width
If IsObject(.Tag) Then
Set nTag = .Tag
Else
nTag = .Tag
End If
If .ButtonMenus.Count Then
Set nButtonMenus = New Collection
For Each nButtonMenu In .ButtonMenus
With nButtonMenu
nButtonMenus.Add _
Array(.Enabled, .Key, .Text, .Visible, .Tag)
End With
Next
End If
Toolbar.Buttons.Remove nIndex
If nImage = "0" Then
Set Button = Toolbar.Buttons.Add(nIndex - 1, _
nKey, nCaption, nStyle)
Else
Set Button = Toolbar.Buttons.Add(nIndex - 1, _
nKey, nCaption, nStyle, nImage)
End If
With Button
.Description = nDescription
.Enabled = nEnabled
.MixedState = nMixedState
.ToolTipText = nToolTipText
.Value = nValue
.Visible = nVisible
If .Style = tbrPlaceholder Then
.Width = nWidth
End If
If IsObject(nTag) Then
Set .Tag = nTag
Else
.Tag = nTag
End If
If Not (nButtonMenus Is Nothing) Then
With .ButtonMenus
For Each nButtonMenuVar In nButtonMenus
With .Add(, nButtonMenuVar(1), nButtonMenuVar(2))
.Enabled = nButtonMenuVar(0)
.Visible = nButtonMenuVar(3)
If IsObject(nButtonMenuVar(4)) Then
Set .Tag = nButtonMenuVar(4)
Else
.Tag = nButtonMenuVar(4)
End If
End With
Next
End With
End If
End With
zSetToolbarPlaceholder Toolbar, CallBackObject
End If
End With
End Sub
Public Sub ToolbarButtonDown(Toolbar As Toolbar, Button As Button, _
Optional CallBackObject As Object)
Dim nIndex As Long
Dim nCaption As String
Dim nDescription As String
Dim nEnabled As Boolean
Dim nImage As String
Dim nKey As String
Dim nMixedState As String
Dim nStyle As ButtonStyleConstants
Dim nToolTipText As String
Dim nValue As ValueConstants
Dim nVisible As Boolean
Dim nWidth As Single
Dim nTag As Variant
Dim nButtonMenus As Collection
Dim nButtonMenu As ButtonMenu
Dim nButtonMenuVar As Variant
With Button
nIndex = .Index
If nIndex < Toolbar.Buttons.Count Then
nCaption = .Caption
nDescription = .Description
nEnabled = .Enabled
nImage = .Image
nKey = .Key
nMixedState = .MixedState
nStyle = .Style
nToolTipText = .ToolTipText
nValue = .Value
nVisible = .Visible
nWidth = .Width
If IsObject(.Tag) Then
Set nTag = .Tag
Else
nTag = .Tag
End If
If .ButtonMenus.Count Then
Set nButtonMenus = New Collection
For Each nButtonMenu In .ButtonMenus
With nButtonMenu
nButtonMenus.Add _
Array(.Enabled, .Key, .Text, .Visible, .Tag)
End With
Next
End If
Toolbar.Buttons.Remove nIndex
If nImage = "0" Then
Set Button = Toolbar.Buttons.Add(nIndex + 1, _
nKey, nCaption, nStyle)
Else
Set Button = Toolbar.Buttons.Add(nIndex + 1, _
nKey, nCaption, nStyle, nImage)
End If
With Button
.Description = nDescription
.Enabled = nEnabled
.MixedState = nMixedState
.ToolTipText = nToolTipText
.Value = nValue
.Visible = nVisible
If .Style = tbrPlaceholder Then
.Width = nWidth
End If
If IsObject(nTag) Then
Set .Tag = nTag
Else
.Tag = nTag
End If
If Not (nButtonMenus Is Nothing) Then
With .ButtonMenus
For Each nButtonMenuVar In nButtonMenus
With .Add(, nButtonMenuVar(1), nButtonMenuVar(2))
.Enabled = nButtonMenuVar(0)
.Visible = nButtonMenuVar(3)
If IsObject(nButtonMenuVar(4)) Then
Set .Tag = nButtonMenuVar(4)
Else
.Tag = nButtonMenuVar(4)
End If
End With
Next
End With
End If
End With
zSetToolbarPlaceholder Toolbar, CallBackObject
End If
End With
End Sub
Public Sub ToolbarButtonToIndex(Toolbar As Toolbar, _
Button As Button, ByVal Index As Integer, _
Optional CallBackObject As Object)
Dim nIndex As Long
Dim nCaption As String
Dim nDescription As String
Dim nEnabled As Boolean
Dim nImage As String
Dim nKey As String
Dim nMixedState As String
Dim nStyle As ButtonStyleConstants
Dim nToolTipText As String
Dim nValue As ValueConstants
Dim nVisible As Boolean
Dim nWidth As Single
Dim nTag As Variant
Dim nButtonMenus As Collection
Dim nButtonMenu As ButtonMenu
Dim nButtonMenuVar As Variant
With Button
nIndex = .Index
If nIndex <> Index Then
nCaption = .Caption
nDescription = .Description
nEnabled = .Enabled
nImage = .Image
nKey = .Key
nMixedState = .MixedState
nStyle = .Style
nToolTipText = .ToolTipText
nValue = .Value
nVisible = .Visible
nWidth = .Width
If IsObject(.Tag) Then
Set nTag = .Tag
Else
nTag = .Tag
End If
If .ButtonMenus.Count Then
Set nButtonMenus = New Collection
For Each nButtonMenu In .ButtonMenus
With nButtonMenu
nButtonMenus.Add _
Array(.Enabled, .Key, .Text, .Visible, .Tag)
End With
Next
End If
Toolbar.Buttons.Remove nIndex
Select Case Index
Case tbiToTop
Index = 1
Case tbiToBottom
Index = Toolbar.Buttons.Count + 1
End Select
If nImage = "0" Then
Set Button = Toolbar.Buttons.Add(Index, _
nKey, nCaption, nStyle)
Else
Set Button = Toolbar.Buttons.Add(Index, _
nKey, nCaption, nStyle, nImage)
End If
With Button
.Description = nDescription
.Enabled = nEnabled
.MixedState = nMixedState
.ToolTipText = nToolTipText
.Value = nValue
.Visible = nVisible
If .Style = tbrPlaceholder Then
.Width = nWidth
End If
If IsObject(nTag) Then
Set .Tag = nTag
Else
.Tag = nTag
End If
If Not (nButtonMenus Is Nothing) Then
With .ButtonMenus
For Each nButtonMenuVar In nButtonMenus
With .Add(, nButtonMenuVar(1), nButtonMenuVar(2))
.Enabled = nButtonMenuVar(0)
.Visible = nButtonMenuVar(3)
If IsObject(nButtonMenuVar(4)) Then
Set .Tag = nButtonMenuVar(4)
Else
.Tag = nButtonMenuVar(4)
End If
End With
Next
End With
End If
End With
zSetToolbarPlaceholder Toolbar, CallBackObject
End If
End With
End Sub
Die zum Ende der Prozeduren aufgerufene Hilfsprozedur zSetToolbarPlaceholder sorgt dafür, dass beim Verschieben von Buttons die Positionen von Steuerelementen aktualisiert werden können, wenn diese an einen Button des Stils tbrPlaceholder geknüpft sind. Dazu können Sie im Form (oder in einem beliebigen anderen Objekt, das sie als optionalen Parameter CallBackObject der oben stehenden Prozeduren übergeben können) eine als "Public" oder "Friend" deklarierte Prozedur mit dem Namen SetToolbarPlaceholder und den Parametern Toolbar und Button anlegen (Beispiel siehe unten). In der Funktion zSetToolbarPlaceholder wird diese Prozedur für jeden Button des Stils tbrPlaceholder aufgerufen, so dass Sie dort anhand der Positions-Eigenschaften (Left, Top, Width, Height) des Buttons das daran geknüpfte Steuerelement nachführen können.
Geben Sie beim Aufruf der oben stehenden Prozeduren kein CallBackObject an, wird das Parent-Objekt der Toolbar (in der Regel das Form, auf dem die Toolbar platziert ist) als CallBackObject angenommen. Anschließend wird versucht, die Prozedur in diesem CallBackObject aufzurufen. Bei dem Test-Aufruf wird in beiden Parameter Nothing übergeben - die Prozedur im CallbackObject sollte also nur reagieren, wenn mindestens der Button-Parameter nicht Nothing ist. Schlägt der Testaufruf fehl, weil die Prozedur nicht vorhanden ist (Fehler-Nr. 438) wird zSetToolbarPlaceholder nicht weiter ausgeführt
Private Sub zSetToolbarPlaceholder(Toolbar As Toolbar, _
CallBackObject As Object)
Dim nButton As Button
Dim nCallBackObject As Object
If CallBackObject Is Nothing Then
Set nCallBackObject = Toolbar.Parent
Else
Set nCallBackObject = CallBackObject
End If
With nCallBackObject
On Error Resume Next
Toolbar.Parent.SetToolbarPlaceholder Nothing, Nothing
If Err.Number = 438 Then
Exit Sub
End If
On Error GoTo 0
For Each nButton In Toolbar.Buttons
If nButton.Style = tbrPlaceholder Then
.SetToolbarPlaceholder Toolbar, nButton
End If
Next
End With
End Sub
Eine im CallBackObject anzulegende Prozedur SetToolbarPlaceholder könnte in etwa wie folgt aussehen - hier wird angenommen, dass das an einen Placeholder-Button geknüpfte Steuerelement in der Tag-Eigenschaft des Buttons abgelegt ist:
Public Sub SetToolbarPlaceholder(Toolbar As Toolbar, _
Button As Button)
Dim nControl As Control
If Not (Button Is Nothing) Then
With Button
Set nControl = .Tag
nControl.Move .Left, .Top + _
((.Height - nControl.Height) \ 2) _
+ Screen.TwipsPerPixelY, .Width
nControl.Visible = .Visible
End With
End If
End Sub
Falls die Toolbar auf einem UserControl platziert sein sollte, können Sie das UserControl nicht direkt als CallBackObject übergeben. Sie müssen es erst mittels der folgenden Funktion CUcl in ein übergebbares Objekt "konvertieren" (mehr dazu siehe  "UserControl unter Kontrolle").
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (VarDest As Any, VarSource As Any, _
ByVal BytesToCopy As Long)
Public Function CUcl(ByVal iUCL As Variant) As UserControl
Dim nUCL As UserControl
CopyMemory nUCL, ObjPtr(iUCL), 4
Set CUcl = nUCL
CopyMemory nUCL, 0&, 4
End Function
Eine Übergabe eines UserControls als CallBackObject sähe beispielsweise wie folgt aus:
ToolbarButtonToIndex Toolbar1, Toolbar1.Buttons("key"), _
NeuerIndex, CUcl(MeinUserControl)
|