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
Diese Seite wurde zuletzt aktualisiert am 04.12.2000

Diese Seite wurde zuletzt aktualisiert am 04.12.2000
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicAddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zur AVB-Web-Site, Kontakt und Impressum

Zurück...

Vertikaler Button

Zurück...


Anzeige

(-hg) mailto:hg_verticalbutton@aboutvb.de

Schaltflächen und CheckBoxen mit einer vertikalen Beschriftung (um 90° gedreht) gibt es in Visual Basic leider nicht. Zwar könnten Sie solche Steuerelemente auf der Basis eines UserControls von Grund auf neu erstellen - zur Darstellung einer vertikalen Beschriftung und der Erscheinungsbilder der verschiedenen Phasen einer Schaltfläche stehen die benötigten API-Funktionen durchaus zur Verfügung. Doch das würde einen immensen Aufwand bedeuten: Auswertung von Maus- und Tastatur-Ereignissen, Darstellung der Phasen, Darstellung des Fokus, Zeichnen der Beschriftung unter Berücksichtigung des korrekten Fonts und dergleichen mehr.

Vertikale Schaltflächen und CheckBoxen

Vertikale Schaltflächen und CheckBoxen

Wenn Sie damit leben können, dass eine solche vertikale Schaltfläche oder CheckBox nicht hundertprozentig ihre horizontalen Vettern emulieren, können Sie ab Visual Basic 6 ein TabStrip-Steuerelement zweckentfremden. Denn dieses bietet die vertikale Darstellung und kommt im Schaltflächen-Stil dem gewünschten Ergebnis sehr nahe. Lediglich einige wenige kleinere Abstriche hätten Sie zu machen: Zum ersten ist weder eine Darstellung der Fokus-Inhaberschaft noch die Verwendung als Default-Schaltfläche möglich - da Sie vertikale Schaltflächen wahrscheinlich eher in spezielleren Form-Layouts verwenden werden, ist das wohl nicht so schwerwiegend. Zum zweiten funktioniert das Weiterschalten innerhalb der TabIndex-Reihenfolge nicht mit den Cursor-Tasten, da das TabStrip-Steuerelement diese eigentlich zur Weiterschaltung der Tab-Register verwendet. Und schließlich kann eine CheckBox so nur im Schaltflächen-Stil erscheinen. Außerdem haben wir darauf verzichtet, die Schaltfläche mit einem Symbol versehen zu können - der Aufwand, noch eine Imageliste hinzuzufügen erschien uns denn doch ein wenig hoch. Sie können dies aber sicher leicht nachrüsten, wenn Sie das benötigen sollten.

Ein weiterer kleiner Nachteil wäre vielleicht, dass Sie die Microsoft Common Controls zusammen mit Ihrer Anwendung ausliefern müssen. Doch falls Sie die Common Controls (TreeView, ListView, Toolbar usw.) sowieso in Ihrer Anwendung verwenden sollten, wäre dieser Punkt bedeutungslos.

Da das TabStrip-Steuerelement allerdings an einigen Stellen ein wenig ausgetrickst werden muss, und auch um die Positionierung so einfach wie einer originalen Schaltfläche oder CheckBox werden zu lassen, verpacken wir es in das UserControl "VButton". Das so entstehende neue Steuerelement bietet alle funktionalen Eigenschaften einer normalen Schaltfläche bzw. CheckBox (Caption, Enabled, Font, MouseIcon, MousePointer), abgesehen von Cancel und Default (Beachten Sie bitte, dass abweichend die Value-Eigenschaft hier vom Datentyp Boolean ist). Auch die gewohnten Ereignisse stehen zur Verfügung: Click, MouseDown, MouseMove, MouseUp, KeyDown, KeyPress und KeyUp.

Darüber hinaus können Sie über die Eigenschaft Orientation die Laufrichtung der Beschriftung festlegen - von unten nach oben oder von oben nach unten. Über die Eigenschaft Style legen Sie fest, ob es eine einfache Schaltfläche oder eine CheckBox sein soll. Im Gegensatz zu einer normalen Schaltfläche können Sie über die Eigenschaft AutoSize auch noch festlegen, ob sich die Größe der Schaltfläche an die Beschriftung anpassen soll - das ist ein kleines Abfallprodukt der Fähigkeiten des TabStrip-Steuerelements.

Private mInClick As Boolean
Private mNoClick As Boolean

Private WithEvents eFont As StdFont

Public Enum VButtonMousePointerConstants
  vbtnDefault = vbDefault
  vbtnArrow = vbArrow
  vbtnCrosshair = vbCrosshair
  vbtnIbeam = vbIbeam
  vbtnIconPointer = vbIconPointer
  vbtnSizePointer = vbSizePointer
  vbtnSizeNESW = vbSizeNESW
  vbtnSizeNS = vbSizeNS
  vbtnSizeNWSE = vbSizeNWSE
  vbtnSizeWE = vbSizeWE
  vbtnUpArrow = vbUpArrow
  vbtnHourglass = vbHourglass
  vbtnNoDrop = vbNoDrop
  vbtnArrowHourglass = vbArrowHourglass
  vbtnArrowQuestion = vbArrowQuestion
  vbtnSizeAll = vbSizeAll
  vbtnCustom = vbCustom
End Enum

Public Enum VButtonOrientationConstants
  vbtnLeft
  vbtnRight
End Enum

Public Enum VButtonStyleConstants
  vbtnCommand
  vbtnCheck
End Enum

Public Event Click()
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 KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)

Private pMousePointer As VButtonMousePointerConstants
Private pStyle As VButtonStyleConstants
Private pValue As Boolean

Public Property Get AutoSize() As Boolean
  Select Case ts.TabWidthStyle
    Case tabNonJustified
      AutoSize = True
    Case tabFixed
      AutoSize = False
  End Select
End Property

Public Property Let AutoSize(ByVal New_AutoSize As Boolean)
  With ts
    Select Case New_AutoSize
      Case False
        .TabWidthStyle = tabFixed
      Case True
        .TabFixedHeight = 0
        .TabWidthStyle = tabNonJustified
    End Select
    zRestoreValue
  End With
  UserControl_Resize
  PropertyChanged "AutoSize"
End Property

Public Property Get Caption() As String
  Caption = ts.Tabs(1).Caption
End Property

Public Property Let Caption(New_Caption As String)
  ts.Tabs(1).Caption = New_Caption
  UserControl_Resize
  PropertyChanged "Caption"
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
  PropertyChanged "Enabled"
End Property

Public Property Get Font() As StdFont
  Set Font = ts.Font
End Property

Public Property Let Font(New_Font As StdFont)
  zSetFont New_Font
End Property

Public Property Set Font(New_Font As StdFont)
  zSetFont New_Font
End Property

Private Sub zSetFont(New_Font As StdFont)
  With ts
    Set .Font = New_Font
    Set eFont = .Font
  End With
  UserControl_Resize
  PropertyChanged "Font"
End Sub

Private Sub eFont_FontChanged(ByVal PropertyName As String)
  UserControl_Resize
End Sub

Public Property Get MouseIcon() As StdPicture
  Set MouseIcon = ts.MouseIcon
End Property

Public Property Let MouseIcon(New_MouseIcon As StdPicture)
  zSetMouseIcon New_MouseIcon
End Property

Public Property Set MouseIcon(New_MouseIcon As StdPicture)
  zSetMouseIcon New_MouseIcon
End Property

Private Sub zSetMouseIcon(New_MouseIcon As StdPicture)
  Set ts.MouseIcon = New_MouseIcon
  PropertyChanged "MouseIcon"
End Sub

Public Property Get MousePointer() As VButtonMousePointerConstants
  MousePointer = pMousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer _
 As VButtonMousePointerConstants)

  pMousePointer = New_MousePointer
  If Ambient.UserMode Then
    ts.MousePointer = pMousePointer
  End If
  PropertyChanged "MousePointer"
End Property

Public Property Get Orientation() As VButtonOrientationConstants
  Orientation = ts.Placement - tabPlacementLeft
End Property

Public Property Let Orientation(ByVal New_Orientation _
 As VButtonOrientationConstants)

  With ts
    Select Case New_Orientation
      Case .Placement - tabPlacementLeft
      Case vbtnLeft, vbtnRight
        .Placement = New_Orientation + tabPlacementLeft
        zRestoreValue
        PropertyChanged "Orientation"
      Case Else
        Err.Raise 380
    End Select
  End With
End Property

Public Property Get Style() As VButtonStyleConstants
  Style = pStyle
End Property

Public Property Let Style(ByVal New_Style As VButtonStyleConstants)
  Select Case New_Style
    Case pStyle
    Case vbtnCommand, vbtnCheck
      pStyle = New_Style
      If pStyle = vbtnCommand Then
        mNoClick = True
        Me.Value = False
        mNoClick = False
      End If
      PropertyChanged "Style"
    Case Else
      Err.Raise 380
  End Select
End Property

Public Property Get Value() As Boolean
  Value = pValue
End Property

Public Property Let Value(ByVal New_Value As Boolean)
  Select Case pStyle
    Case vbtnCommand
      If New_Value Then
        If mInClick Then
          Exit Property
        End If
        pValue = True
        RaiseEvent Click
      End If
      pValue = False
    Case vbtnCheck
      pValue = New_Value
      With ts
        Select Case pValue
          Case False
            .Tabs(2).Selected = True
          Case True
            .Tabs(1).Selected = True
        End Select
      End With
      PropertyChanged "Value"
  End Select
End Property

Public Sub Refresh()
  UserControl.Refresh
  ts.Refresh
End Sub

Private Sub ts_Click()
  If Not mNoClick Then
    If pStyle = vbtnCommand Then
      mInClick = True
      pValue = True
      RaiseEvent Click
      pValue = False
      mInClick = False
    Else
      RaiseEvent Click
    End If
  End If
End Sub

Private Sub ts_KeyDown(KeyCode As Integer, Shift As Integer)
  RaiseEvent KeyDown(KeyCode, Shift)
  Select Case KeyCode
    Case vbKeyRight, vbKeyLeft, vbKeyUp, vbKeyDown
      KeyCode = 0 'vbKeyTab
    Case vbKeySpace
      mNoClick = True
      ts.Tabs(1).Selected = True
      mNoClick = False
    Case vbKeyReturn
      If pStyle = vbtnCommand Then
        mInClick = True
        pValue = True
        RaiseEvent Click
        pValue = False
        mInClick = False
      End If
  End Select
End Sub

Private Sub ts_KeyPress(KeyAscii As Integer)
  RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub ts_KeyUp(KeyCode As Integer, Shift As Integer)
  RaiseEvent KeyUp(KeyCode, Shift)
  Select Case KeyCode
    Case vbKeyRight, vbKeyDown, vbKeyLeft, vbKeyUp
      KeyCode = 0
    Case vbKeySpace
      Select Case pStyle
        Case vbtnCommand
          ts.Tabs(2).Selected = True
        Case vbtnCheck
          With Me
            .Value = Not .Value
          End With
      End Select
      KeyCode = 0
  End Select
End Sub

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

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

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

  ts.Tabs(1).ToolTipText = Extender.ToolTipText
  RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

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

  If Button = vbLeftButton Then
    Select Case pStyle
      Case vbtnCommand
        mNoClick = True
        ts.Tabs(2).Selected = True
        mNoClick = False
      Case vbtnCheck
        With Me
          .Value = Not .Value
        End With
    End Select
  End If
  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_InitProperties()
  zInit
  ts.Tabs(1).Caption = Ambient.DisplayName
  On Error Resume Next
  ts.Font.Name = "Arial"
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  ts.TabWidthStyle = PropBag.ReadProperty("AutoSize", tabFixed)
  ts.Tabs(1).Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
  UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  Set Me.Font = PropBag.ReadProperty("Font", Ambient.Font)
  Set ts.MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
  Me.MousePointer = PropBag.ReadProperty("MousePointer", vbtnDefault)
  ts.Placement = PropBag.ReadProperty("Orientation", tabPlacementLeft)
  pStyle = PropBag.ReadProperty("Style", vbtnCommand)
  Me.Value = PropBag.ReadProperty("Value", False)
  zInit
End Sub

Private Sub zInit()
  With ts
    Set eFont = .Font
    If pStyle = vbtnCommand Then
      mNoClick = True
      .Tabs(2).Selected = True
      mNoClick = False
    End If
  End With
  On Error Resume Next
  Extender.CausesValidation = False
End Sub

Private Sub UserControl_Resize()
  With ts
    If .TabWidthStyle = tabFixed Then
      .TabFixedHeight = UserControl.ScaleWidth
      .TabFixedWidth = UserControl.ScaleHeight
      .Move 0, 0, .Tabs(1).Height, .Tabs(1).Width
    Else
      .Move 0, 0, .Tabs(1).Height, .Tabs(1).Width
      With .Tabs(1)
        UserControl.Size .Height, .Width
      End With
    End If
  End With
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "AutoSize", ts.TabWidthStyle, tabFixed
  PropBag.WriteProperty "Caption", ts.Tabs(1).Caption, _
   Ambient.DisplayName
  PropBag.WriteProperty "Enabled", UserControl.Enabled, True
  PropBag.WriteProperty "Font", ts.Font, Ambient.Font
  PropBag.WriteProperty "MouseIcon", ts.MouseIcon, Nothing
  PropBag.WriteProperty "MousePointer", pMousePointer, _
   vbtnDefault
  PropBag.WriteProperty "Orientation", ts.Placement, _
   tabPlacementLeft
  PropBag.WriteProperty "Style", pStyle, vbtnCommand
  PropBag.WriteProperty "Value", ts.Tabs(1).Selected, False
End Sub

Private Sub zRestoreValue()
  With ts
    mNoClick = True
    Select Case pValue
      Case True
        .Tabs(1).Selected = True
      Case False
        .Tabs(2).Selected = True
    End Select
    mNoClick = False
  End With
End Sub

Das Projekt avbVerticalButtonOCX (verticalbutton.zip - ca. 8,3 KB)



Komponenten-Übersicht

Schnellsuche



Zum Seitenanfang

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

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer