ABOUT Visual Basic - das Webmagazin: Roll-Container (ActiveX-Control)

ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE

(-hg)

Eine Möglichkeit, Platz bei der Gestaltung eines Forms zu sparen, sind so genannte RollUp-Steuerelemente. Ähnlich wie bei einer ComboBox nimmt das Steuerelement im "aufgerollten" Zustand nur relativ wenig Platz ein. "Ausgerollt" dagegen steht Ihnen eine zusätzliche Fläche zur Verfügung, auf der Sie beliebig weitere Steuerelemente platzieren können. Im Unterschied zu einer ComboBox öffnet sich beim Ausrollen jedoch kein neues Fenster, das im Vordergrund stehend auch über die Fläche des Forms hinausreichen kann. Vielmehr ändert das Rollup-Steuerelement lediglich seine Höhe. Der Aufwand, ein echtes Popupfenster zu erzeugen, das als echter Steuerlement-Container dienen kann, aber keinerlei Fokus-Probleme mit sich bringt und auch nicht das Eltern-Form deaktiviert, ist immens und letztlich kaum sauber in einem UserControl zu kapseln. Für viele Zwecke mag jedoch ein solches vereinfachtes RollUp-Steuerelement genügen.



	Ein ein- und ausrollbarer RollUp-Container bietet zusätzlichen Platz auf einem Form

Wie bei einem Frame-Steuerelement oder bei einer PictureBox können Sie auf dem RollUp-Steuerelement beliebig andere Steuerelemente platzieren. Sie können die gesamte Fläche des Steuerelements belegen, auch die Kopfleiste. Wundern Sie sich nicht, wenn Sie im eingerollten Zustand ein Steuerelement darauf platzieren - es verschwindet sofort. Im ausgerollten Zustand finden Sie es jedoch an der entsprechenden Stelle wieder. Wenn Sie ein Steuerelement sozusagen unter dem Ausklappbereich platzieren möchten, sollten Sie entweder vorübergehend die Gesamthöhe des RollUp-Steuerelements reduzieren, oder das zu platzierende Steuerelement außerhalb der Fläche des RollUp-Steuerelements einfügen und danach erst an die gewünschte Stelle verschieben. Die Innenfläche des RollUp-Containers können Sie aus den Eigenschaften ScaleWidth und ScaleHeight auslesen. Im Gegensatz zur PictureBox können Sie deren Werte jedoch nicht manipulieren - sie liegen immer in der Maßeinheit Twips vor.

Über die Eigenschaft ButtonPosition können Sie festlegen, ob die Schaltfläche zum Ein- und Ausrollen rechts- oder linksseitig erscheinen soll. Diese Schaltfläche können Sie nicht verbergen, hingegen jedoch die Titelbeschriftung über die Eigenschaft HeaderVisible. Den Beschriftungstext, dessen Schriftart und Farbe legen Sie über die Eigenschaften HeaderCaption, HeaderFont und HeaderForeColor fest. Die Hintergrundfarbe der Titelleiste setzen Sie in HeaderBackColor. Die Höhe des eingerollten Zustand hängt vom Wert der Eigenschaft HeaderHeight ab, die tatsächliche Höhe im eingerollten Zustand können Sie über die Eigenschaft RollUpSize auslesen..

Den Hintergrund des Containers gestalten Sie über die Eigenschaften BackColor und Picture wie bei einer PictureBox.

Zur Entwicklungszeit wie auch zur Laufzeit rollen Sie das RollUp-Steuerelement über die Eigenschaft State ein (ruRollUp/-1) und aus (ruRollDown/0). Zur Laufzeit wird vor der Änderung des Zustandes das Ereignis BeforeStateChange ausgelöst. In dessen Parameter OldState erhalten Sie den noch aktuellen Zustand. Sie können die anstehende Zustandsänderung verwerfen, indem Sie im Parameter Cancel den Wert True zurückgeben. Nach vollzogener Zustandsänderung wird das Ereignis StateChanged ausgelöst, über dessen Parameter State Sie den Wert des nun aktuellen Zustandes erhalten. Das Ereignis Resize wird nur ausgelöst, wenn sich die Gesamtabmessungen des RollUp-Steuerelements geändert haben, nicht jedoch beim Ein- und Ausrollen. Die Mausereignisse Click, DblClick (nur bei der Container-Fläche), MouseDown, MouseMove und MouseUp werden separat für die Titelleiste (Header...) und für die Container-Fläche ausgelöst.

Beim Aus- und Einrollen wird der Fokus automatisch auf das in der TabIndex-Folge erste Steuerelement gesetzt, das auf dem RollUp-Container platziert ist. Soll nach dem Einrollen ein anderes, nicht auf dem RollUp-Container platziertes Steuerelement den Fokus erhalten, können Sie diesen im StateChanged-Ereignis zuweisen.

Das RollUp-Steuerelement können Sie gleichermaßen und ohne Einschränkungen sowohl unter Visual Basic 5 als auch unter Visual Basic 6 kompilieren und verwenden.

Private Enum RollUpStateBitmapConstants
  rusUp = 101
  rusDown = 102
End Enum

Private mNoResizeEvent As Boolean

Public Event BeforeStateChange(ByVal OldState _
 As RollUpStateConstants, Cancel As Boolean)

Public Event Click()
Public Event DblClick()
Public Event HeaderClick()
Public Event HeaderMouseDown(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event HeaderMouseMove(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event HeaderMouseUp(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseDown(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event Resize()
Public Event StateChanged(ByVal State As RollUpStateConstants)

Public Enum RollUpBorderStyleContants
  ruBorderStyleNone
  ruBorderStyleSunken
End Enum

Public Enum RollUpButtonPositionConstants
  ruButtonRight
  ruButtonLeft
End Enum

Public Enum RollUpStateConstants
  ruRollDown = False
  ruRollUp = True
End Enum

Private pBorderStyle As RollUpBorderStyleContants
Private pButtonPosition As RollUpButtonPositionConstants
Private pHeaderHeight As Single
Private pHeaderVisible As Boolean
Private pState As RollUpStateConstants

Public Property Get BackColor() As OLE_COLOR
  BackColor = picBack.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  picBack.BackColor = New_BackColor
  PropertyChanged "BackColor"
End Property

Public Property Get BorderStyle() As RollUpBorderStyleContants
  BorderStyle = pBorderStyle
End Property

Public Property Let BorderStyle _
(ByVal New_BorderStyle As RollUpBorderStyleContants)

  Select Case New_BorderStyle
    Case pBorderStyle
      Exit Property
    Case ruBorderStyleNone, ruBorderStyleSunken
      pBorderStyle = New_BorderStyle
    Case Else
      Err.Raise 380
  End Select
  UserControl_Resize
  PropertyChanged "BorderStyle"
End Property

Public Property Get ButtonPosition() _
 As RollUpButtonPositionConstants

  ButtonPosition = pButtonPosition
End Property

Public Property Let ButtonPosition _
 (ByVal New_ButtonPosition As RollUpButtonPositionConstants)

  Select Case New_ButtonPosition
    Case pButtonPosition
      Exit Property
    Case ruButtonRight, ruButtonLeft
    Case Else
      Err.Raise 380
  End Select
  pButtonPosition = New_ButtonPosition
  UserControl_Resize
  PropertyChanged "ButtonPosition"
End Property

Public Property Get Enabled() As Boolean
  Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
  UserControl.Enabled = New_Enabled
  chkHeader.Enabled = New_Enabled
  PropertyChanged "Enabled"
End Property

Public Property Get HeaderBackColor() As OLE_COLOR
  HeaderBackColor = chkHeader.BackColor
End Property

Public Property Let HeaderBackColor _
 (ByVal New_HeaderBackColor As OLE_COLOR)

  chkHeader.BackColor = New_HeaderBackColor
  PropertyChanged "HeaderBackColor"
End Property

Public Property Get HeaderCaption() As String
  HeaderCaption = chkHeader.Caption
End Property

Public Property Let HeaderCaption(New_HeaderCaption As String)
  chkHeader.Caption = New_HeaderCaption
  PropertyChanged "HeaderCaption"
End Property

Public Property Get HeaderFont() As Font
  Set HeaderFont = chkHeader.Font
End Property

Public Property Let HeaderFont(New_HeaderFont As Font)
  zSetHeaderFont New_HeaderFont
End Property

Public Property Set HeaderFont(New_HeaderFont As Font)
  zSetHeaderFont New_HeaderFont
End Property

Private Sub zSetHeaderFont(New_HeaderFont As Font)
  Set chkHeader.Font = New_HeaderFont
  PropertyChanged "HeaderFont"
End Sub

Public Property Get HeaderForeColor() As OLE_COLOR
  HeaderForeColor = chkHeader.ForeColor
End Property

Public Property Let HeaderForeColor_
 (ByVal New_HeaderForeColor As OLE_COLOR)

  chkHeader.ForeColor = New_HeaderForeColor
  PropertyChanged "HeaderForeColor"
End Property

Public Property Get HeaderHeight() As Single
  HeaderHeight = pHeaderHeight
End Property

Public Property Let HeaderHeight_
 (ByVal New_HeaderHeight As Single)

  Select Case New_HeaderHeight
    Case Is > 0
      pHeaderHeight = New_HeaderHeight
      UserControl_Resize
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "HeaderHeight"
End Property

Public Property Get HeaderLeft() As Single
  HeaderLeft = chkHeader.Left
End Property

Public Property Get HeaderVisible() As Boolean
  HeaderVisible = pHeaderVisible
End Property

Public Property Let HeaderVisible(ByVal New_HeaderVisible As Boolean)
  pHeaderVisible = New_HeaderVisible
  chkHeader.Visible = pHeaderVisible
  PropertyChanged "HeaderVisible"
End Property

Public Property Get HeaderWidth() As Single
  HeaderWidth = chkHeader.Width
End Property

Public Property Get hWnd() As Long
  hWnd = UserControl.hWnd
End Property

Public Property Get Picture() As Picture
  Set Picture = picBack.Picture
End Property

Public Property Let Picture(New_Picture As Picture)
  zSetPicture New_Picture
End Property

Public Property Set Picture(New_Picture As Picture)
  zSetPicture New_Picture
End Property

Private Sub zSetPicture(New_Picture As Picture)
  Set picBack.Picture = New_Picture
  PropertyChanged "Picture"
End Sub

Public Property Get State() As RollUpStateConstants
  State = pState
End Property

Public Property Let State(ByVal New_State As RollUpStateConstants)
  Dim nCancel As Boolean
  
  Select Case New_State
    Case pState
      Exit Property
    Case ruRollDown, ruRollUp
      RaiseEvent BeforeStateChange(pState, nCancel)
      If Not nCancel Then
        mNoResizeEvent = True
        pState = New_State
        UserControl_Resize
        tmrStateChange.Enabled = True
        mNoResizeEvent = False
      End If
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "State"
End Property

Public Property Get RollUpSize() As Single
  RollUpSize = picBack.Height
End Property

Public Property Get ScaleHeight() As Single
  ScaleHeight = UserControl.ScaleHeight
End Property

Public Property Get ScaleWidth() As Single
  ScaleWidth = UserControl.ScaleWidth
End Property

Private Sub chkButton_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  chkButton.Value = vbChecked
  picBack.SetFocus
  Me.State = Not Me.State
End Sub

Private Sub chkButton_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  chkButton.Value = vbUnchecked
End Sub

Private Sub chkHeader_Click()
  RaiseEvent HeaderClick
End Sub

Private Sub chkHeader_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  picBack.SetFocus
  RaiseEvent HeaderMouseDown(Button, Shift, X, Y)
End Sub

Private Sub chkHeader_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent HeaderMouseMove(Button, Shift, X, Y)
End Sub

Private Sub chkHeader_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent HeaderMouseUp(Button, Shift, X, Y)
  RaiseEvent HeaderClick
End Sub

Private Sub picBack_Click()
  RaiseEvent Click
End Sub

Private Sub picBack_DblClick()
  RaiseEvent DblClick
End Sub

Private Sub picBack_GotFocus()
  Dim nControl As Control
  Dim nTabStop As Boolean
  Dim nSetControl As Control
  Dim nLowestTabIndex As Integer
  
  With UserControl
    On Error Resume Next
    nLowestTabIndex = .ParentControls.Count
    For Each nControl In .ContainedControls
      nTabStop = False
      Err.Clear
      With nControl
        nTabStop = .TabStop
        If Err.Number = 0 Then
          If .Visible And .Enabled Then
            If nTabStop Then
              If .TabIndex < nLowestTabIndex Then
                Set nSetControl = nControl
              End If
            End If
          End If
        End If
      End With
    Next
  End With
  If Not (nSetControl Is Nothing) Then
    nSetControl.SetFocus
  End If
End Sub

Private Sub picBack_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub picBack_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub picBack_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub tmrResize_Timer()
  tmrResize.Enabled = False
  UserControl_Resize
End Sub

Private Sub tmrStateChange_Timer()
  tmrStateChange.Enabled = False
  RaiseEvent StateChanged(pState)
End Sub

Private Sub UserControl_Initialize()
  pBorderStyle = ruBorderStyleSunken
  pButtonPosition = ruButtonRight
  pHeaderVisible = True
  pHeaderHeight = 20 * Screen.TwipsPerPixelY
End Sub

Private Sub UserControl_InitProperties()
  chkHeader.Caption = Ambient.DisplayName
  tmrResize.Enabled = True
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  With PropBag
    picBack.BackColor = .ReadProperty("BackColor", vbButtonFace)
    pBorderStyle = .ReadProperty("BorderStyle", ruBorderStyleSunken)
    Me.Enabled = .ReadProperty("Enabled", True)
    chkHeader.BackColor = _
     .ReadProperty("HeaderBackColor", vbButtonFace)
    pButtonPosition = _
     .ReadProperty("ButtonPosition", ruButtonRight)
    chkHeader.Caption = _
     .ReadProperty("HeaderCaption", Ambient.DisplayName)
    Set chkHeader.Font = _
     .ReadProperty("HeaderFont", Ambient.Font)
    chkHeader.ForeColor = _
     .ReadProperty("HeaderForeColor", vbWindowText)
    pHeaderHeight = _
     .ReadProperty("HeaderHeight", chkButton.Height)
    pHeaderVisible = .ReadProperty("HeaderVisible", True)
    Set picBack.Picture = .ReadProperty("Picture", Nothing)
    pState = .ReadProperty("State", False)
  End With
  tmrResize.Enabled = True
End Sub

Private Sub UserControl_Resize()
  Dim nBitMap As RollUpStateBitmapConstants
  
  With UserControl
    picBack.Visible = False
    Select Case pState
      Case ruRollUp
        nBitMap = rusUp
        .BackStyle = 0
        Select Case pBorderStyle
          Case ruBorderStyleNone
            With picBack
              .BorderStyle = 0
              .Height = pHeaderHeight
            End With
          Case ruBorderStyleSunken
            With picBack
              .BorderStyle = 1
              .Height = .Height - .ScaleHeight + pHeaderHeight
            End With
        End Select
      Case ruRollDown
        nBitMap = rusDown
        .BackStyle = 1
        picBack.BorderStyle = pBorderStyle
        picBack.Height = .ScaleHeight
    End Select
    With chkButton
      Select Case pButtonPosition
        Case ruButtonRight
          .Move picBack.ScaleWidth - pHeaderHeight, 0, _
           pHeaderHeight, pHeaderHeight
          chkHeader.Move 0, 0, picBack.ScaleWidth - _
           pHeaderHeight, pHeaderHeight
        Case ruButtonLeft
          .Move 0, 0, pHeaderHeight, pHeaderHeight
          chkHeader.Move pHeaderHeight, 0, picBack.ScaleWidth - _
           pHeaderHeight, pHeaderHeight
      End Select
      Set .Picture = LoadResPicture(nBitMap, vbResBitmap)
    End With
    chkHeader.Visible = pHeaderVisible
    picBack.Visible = True
    If Not mNoResizeEvent Then
      RaiseEvent Resize
    End If
  End With
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  With PropBag
    .WriteProperty "BackColor", picBack.BackColor, vbButtonFace
    .WriteProperty "BorderStyle", pBorderStyle, ruBorderStyleSunken
    .WriteProperty "Enabled", UserControl.Enabled, True
    .WriteProperty "HeaderBackColor", _
     chkHeader.BackColor, vbButtonFace
    .WriteProperty "ButtonPosition", pButtonPosition, _
     ruButtonRight
    .WriteProperty "HeaderCaption", chkHeader.Caption, _
     Ambient.DisplayName
    .WriteProperty "HeaderFont", chkHeader.Font, Ambient.Font
    .WriteProperty "HeaderForeColor", chkHeader.ForeColor, _
     vbWindowText
    .WriteProperty "HeaderHeight", pHeaderHeight, _
     chkButton.Height
    .WriteProperty "HeaderVisible", pHeaderVisible, True
    .WriteProperty "Picture", picBack.Picture, Nothing
    .WriteProperty "State", pState, False
  End With
End Sub

Das Projekt avbRollUpContainer (rollup.zip - ca. 8,8 KB)

					Copyright © 1999 - 2023 Harald M. Genauck, ip-pro gmbh / Impressum