|
|
|
|
|
|
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.
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
|
|
|