|
Wird die Eigenschaft SelRange des Slider-Steuerelements aus den Microsoft Common Controls auf True gesetzt, wird ein Bereichsbalken angezeigt. Dessen Start und Länge wird über die Eigenschaften SelStart und SelLength des Sliders festgelegt.
Den Umgang mit diesem Bereichsbalken vereinfacht die Klasse clsSliderRange. Sie lässt sich in drei verschiedenen Modi nutzen, die über die Eigenschaft Mode festgelegt werden. Im Modus srModeSimple beginnt der Bereichsbalken automatisch mein Minimum-Wert (Eigenschaft Min des Sliders) und reicht immer bis zum eingestellten Wert (Position des Schiebers). Der Modus srModeExtended ermöglicht eine beliebige Startposition (SelStart-Eigenschaft der Klasse) des Bereichsbalkens, wobei die Endposition (SelEnd-Eigenschaft der Klasse) weiterhin vom aktuellen Wert festgelegt wird bzw. umgekehrt den aktuellen festlegt. Dabei kann die Endposition auch vor der Startposition liegen. Im Modus srModeLimited hingegen wird der Bereichsbalken mit SelStart und SelEnd festgelegt und begrenzt den Einstellbereich des Schiebers.
Sie legen für jedes Slider-Steuerelement eine Instanz der Klasse clsSliderRange an und übergeben ihr bei einem erstmaligen (und nur einmal notwendigen) Aufruf der Init-Methode den betreffenden Slider. In den weiteren optionalen Parametern der Init-Methode können Sie zugleich den Modus, die Start- und die Endposition und den aktuellen Wert des Sliders voreinstellen.
Diese Einstellungen und Werte können Sie auch jederzeit nachträglich über die Eigenschaften Mode, SelEnd, SelStart und Value der Klasse auslesen und setzen. Die aktuelle Länge des Bereichsbalkens können Sie über SelLength auslesen, jedoch nicht ändern. Auf die Eigenschaften SelLength, SelStart und Value sollten Sie daher auch nur über die Klasse zugreifen, und nicht über den Slider direkt. Die übrigen Eigenschaften des Sliders bleiben von der Klasse unberührt - auf diese können Sie wie gewohnt beliebig zugreifen.
Mit der Methode SwapSelStartEnd vertauschen Sie schließlich noch in den beiden Modi srModeExtended und srModeLimited die Start- und die Endposition. Im Modus srModeExtended wird dabei der Schieber (Value) auf die Endposition umgesetzt.
Ein paar Besonderheiten bietet die von der Klasse kontrollierte Tastatur- und Maus-Steuerung. Im Modus srModeSimple wird der Schieber wie gewohnt mit den Cursor-Tasten oder mit der Maus bewegt - die Umschalt-Taste und die Strg-Taste haben keinerlei Auswirkungen.
Im Modus srModeExtended wird die Startposition beim Niederdrücken der linken Maustaste und gleichzeitig gedrückter Umschalt-Taste neu gesetzt. Ist dagegen die Strg-Taste gedrückt, verschiebt sich der Bereichsbalken mit dem Schieber unter Beibehaltung seiner Länge. Bei der Tastatursteuerung über die Cursortasten bewirkt die Umschalt-Taste die Verschiebung der Startposition anstelle des Schiebers, während die Strg-Taste ebenfalls wie bei der Maussteuerung den Bereichsbalken zusammen mit dem Schieber verschiebt.
Sowohl bei Maus- als auch bei Tastatursteuerung über die Cursortasten bleibt die Umschalttaste im Modus srModeLimited ohne Wirkung. Die Strg-Taste bewirkt dagegen, dass die jeweils erreichte Grenze des Bereichsbalkens überschritten und mit verschoben wird.
Die Tastatur-Ereignisse KeyDown und KeyUp werden vor der Auswertung als Ereignisse der Klasse ausgelöst und können somit vorab kontrolliert und modifiziert werden. Die Maus-Ereignisse MouseDown, MouseMove und MouseUp werden hingegen nach der Verarbeitung als Ereignisse der Klasse weitergegeben - eine Modifikation der Parameter bei Mausereignissen hat ja in VB keine Auswirkungen. Bei jeder Positionsänderung des Schiebers als auch bei Änderungen der Start- und Endpositionen wird das Scroll-Ereignis der Klasse ausgelöst. Sie sollten diese sechs Ereignisse anstelle der Original-Ereignisse des Slider-Steuerelements verwenden.
Private WithEvents eSlider As Slider
Private mMoveRange As Boolean
Private mMoveLimit As Boolean
Public Event Scroll()
Public Event MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Event MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Event MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Enum srModeConstants
srModeSimple
srModeExtended
srModeLimited
End Enum
Private pMode As srModeConstants
Private pSelEnd As Long
Private pSelStart As Long
Public Property Get Mode() As srModeConstants
Mode = pMode
End Property
Public Property Let Mode(New_Mode As srModeConstants)
Select Case New_Mode
Case pMode
Case srModeSimple
pMode = New_Mode
pSelStart = 0
zSetRange
Case srModeExtended, srModeLimited
pMode = New_Mode
zSetRange
Case Else
Err.Raise 380
End Select
End Property
Public Property Get SelEnd() As Long
SelEnd = pSelEnd
End Property
Public Property Let SelEnd(New_SelEnd As Long)
With eSlider
Select Case New_SelEnd
Case .Min To .Max
If pSelEnd <> New_SelEnd Then
pSelEnd = New_SelEnd
Select Case pMode
Case srModeLimited
Case Else
.Value = pSelEnd
End Select
zSetRange
End If
Case Else
Err.Raise 380
End Select
End With
End Property
Public Property Get SelLength() As Long
SelLength = eSlider.SelLength
End Property
Public Property Get SelStart() As Long
SelStart = pSelStart
End Property
Public Property Let SelStart(New_SelStart As Long)
With eSlider
Select Case New_SelStart
Case .Min To .Max
If pSelStart <> New_SelStart Then
pSelStart = New_SelStart
zSetRange
End If
Case Else
Err.Raise 380
End Select
End With
End Property
Public Property Get Value() As Long
Value = eSlider.Value
End Property
Public Property Let Value(New_Value As Long)
With eSlider
Select Case New_Value
Case .Value
Case Is < .Min
.Value = .Min
Case Is > .Max
.Value = .Max
Case Else
.Value = New_Value
End Select
Select Case pMode
Case srModeLimited
Case Else
pSelEnd = eSlider.Value
End Select
End With
zSetRange
End Property
Public Sub Init(Slider As Slider, _
Optional ByVal Mode As srModeConstants = srModeSimple, _
Optional ByVal SelStart As Long, _
Optional ByVal SelEnd As Long, _
Optional ByVal Value As Long)
Set eSlider = Slider
pMode = Mode
pSelEnd = SelEnd
With eSlider
Select Case pMode
Case srModeSimple
pSelStart = .Min
.Value = pSelEnd
Case srModeExtended
Me.SelStart = SelStart
.Value = pSelEnd
Case srModeLimited
.Value = Value
End Select
End With
zSetRange
End Sub
Public Sub SwapSelStartEnd()
Dim n As Long
If pMode Then
n = pSelStart
pSelStart = pSelEnd
pSelEnd = n
Select Case pMode
Case srModeLimited
Case Else
eSlider.Value = pSelEnd
End Select
zSetRange
End If
End Sub
Private Sub eSlider_KeyDown(KeyCode As Integer, Shift As Integer)
Dim nShift As Integer
RaiseEvent KeyDown(KeyCode, Shift)
Select Case pMode
Case srModeSimple
With eSlider
Select Case KeyCode
Case vbKeyHome
.Value = .Min
KeyCode = 0
Case vbKeyEnd
.Value = .Max
KeyCode = 0
End Select
End With
zSetRange
Case srModeLimited
With eSlider
Select Case KeyCode
Case vbKeyHome
.Value = .Min
If Shift = vbCtrlMask Then
mMoveLimit = True
Select Case pSelEnd
Case Is >= pSelStart
pSelStart = .Min
.SelStart = pSelStart
.SelLength = pSelEnd - pSelStart
Case Is < pSelStart
pSelEnd = .Min
.SelStart = pSelEnd
.SelLength = pSelStart - pSelEnd
End Select
RaiseEvent Scroll
Else
zSetRange
End If
KeyCode = 0
Case vbKeyEnd
.Value = .Max
If Shift = vbCtrlMask Then
mMoveLimit = True
Select Case pSelEnd
Case Is >= pSelStart
pSelEnd = .Max
.SelLength = pSelEnd - pSelStart
Case Is < pSelStart
pSelStart = .Max
.SelLength = pSelStart - pSelEnd
End Select
RaiseEvent Scroll
Else
zSetRange
End If
KeyCode = 0
Case vbKeyRight, vbKeyLeft, vbKeyUp, vbKeyDown, _
vbKeyPageDown, vbKeyPageUp
If Shift = vbCtrlMask Then
mMoveLimit = True
Exit Sub
End If
End Select
End With
Case srModeExtended
nShift = Shift
Select Case KeyCode
Case vbKeyHome
With eSlider
Select Case nShift
Case 0
pSelEnd = .Min
.Value = pSelEnd
zSetRange
Case vbShiftMask
pSelStart = .Min
zSetRange
Case vbCtrlMask
Select Case pSelEnd
Case Is > pSelStart
pSelStart = .Min
pSelEnd = .SelLength
.SelStart = pSelStart
.Value = pSelEnd
Case pSelStart
pSelStart = .Min
pSelEnd = pSelStart
.SelStart = pSelStart
.Value = pSelEnd
Case Is < pSelStart
pSelEnd = .Min
pSelStart = .SelLength
.SelStart = pSelEnd
.Value = pSelEnd
End Select
RaiseEvent Scroll
End Select
End With
KeyCode = 0
Case vbKeyEnd
With eSlider
Select Case nShift
Case 0
pSelEnd = .Max
.Value = pSelEnd
zSetRange
Case vbShiftMask
pSelStart = .Max
zSetRange
Case vbCtrlMask
Select Case pSelEnd
Case Is > pSelStart
pSelEnd = .Max
pSelStart = pSelEnd - .SelLength
.SelStart = pSelStart
.Value = pSelEnd
Case pSelStart
pSelEnd = .Max
pSelStart = pSelEnd
.SelStart = pSelStart
.Value = pSelEnd
Case Is < pSelStart
pSelEnd = .Max - .SelLength
pSelStart = .Max
.SelStart = pSelEnd
.Value = pSelEnd
End Select
RaiseEvent Scroll
End Select
End With
KeyCode = 0
Case Else
Select Case Shift
Case 0
mMoveRange = False
Case vbShiftMask
mMoveRange = False
With eSlider
Select Case KeyCode
Case vbKeyLeft, vbKeyUp
pSelStart = pSelStart - .SmallChange
If pSelStart < .Min Then
pSelStart = .Min
End If
zSetRange
KeyCode = 0
Case vbKeyRight, vbKeyDown
pSelStart = pSelStart + .SmallChange
If pSelStart > .Max Then
pSelStart = .Max
End If
zSetRange
KeyCode = 0
Case vbKeyPageUp
pSelStart = pSelStart - .LargeChange
If pSelStart < .Min Then
pSelStart = .Min
End If
zSetRange
KeyCode = 0
Case vbKeyPageDown
pSelStart = pSelStart + .LargeChange
If pSelStart > .Max Then
pSelStart = .Max
End If
zSetRange
KeyCode = 0
End Select
End With
Case vbCtrlMask
mMoveRange = True
End Select
End Select
End Select
End Sub
Private Sub eSlider_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyControl
mMoveRange = False
mMoveLimit = False
End Select
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub eSlider_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If pMode = srModeExtended Then
Select Case Shift
Case vbShiftMask
mMoveRange = False
pSelStart = eSlider.Value
zSetRange
Case vbCtrlMask
mMoveRange = True
zSetRange
Case 0
mMoveRange = False
End Select
End If
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub eSlider_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Select Case pMode
Case srModeExtended
Select Case Shift
Case vbShiftMask
mMoveRange = False
zSetRange
Case vbCtrlMask
mMoveRange = True
zSetRange
Case 0
mMoveRange = False
End Select
Case srModeLimited
Select Case Shift
Case vbCtrlMask
mMoveLimit = True
Case Else
mMoveLimit = False
End Select
End Select
End If
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub eSlider_MouseUp(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
mMoveRange = False
mMoveLimit = False
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
Private Sub eSlider_Scroll()
Select Case pMode
Case srModeLimited
Case Else
pSelEnd = eSlider.Value
End Select
zSetRange
End Sub
Private Sub zSetRange()
Static sInProc As Boolean
If sInProc Then
Exit Sub
Else
sInProc = True
End If
With eSlider
Select Case pMode
Case srModeSimple
.SelLength = .Value
pSelStart = .Min
.SelStart = pSelStart
Case srModeExtended
If mMoveRange Then
Select Case pSelEnd
Case Is > pSelStart
pSelStart = pSelEnd - .SelLength
If pSelStart < .Min Then
pSelStart = .Min
pSelEnd = .SelLength
.Value = pSelEnd
End If
.SelStart = pSelStart
Case pSelStart
If pSelEnd = .Min Then
pSelEnd = .SelLength
.Value = pSelEnd
pSelStart = .Min
ElseIf pSelEnd = .Max Then
pSelEnd = .Max - .SelLength
pSelStart = .Max
.SelStart = pSelEnd
.Value = pSelEnd
End If
Case Is < pSelStart
If pSelEnd < .Max - .SelLength Then
.SelStart = pSelEnd
pSelStart = pSelEnd + .SelLength
ElseIf pSelEnd >= .Max - .SelLength Then
pSelEnd = .Max - .SelLength
pSelStart = .Max
.SelStart = pSelEnd
.Value = pSelEnd
End If
End Select
Else
Select Case pSelEnd
Case Is > pSelStart
.SelStart = pSelStart
.SelLength = pSelEnd - pSelStart
Case pSelStart
.SelStart = pSelEnd
.SelLength = 0
Case Is < pSelStart
.SelStart = pSelEnd
.SelLength = pSelStart - pSelEnd
End Select
End If
Case srModeLimited
If mMoveLimit Then
Select Case pSelEnd
Case Is >= pSelStart
Select Case .Value
Case Is > pSelEnd
pSelEnd = .Value
.SelLength = pSelEnd - pSelStart
Case Is < pSelStart
pSelStart = .Value
.SelStart = pSelStart
.SelLength = pSelEnd - pSelStart
End Select
Case Is < pSelStart
Select Case .Value
Case Is > pSelStart
pSelStart = .Value
.SelLength = pSelStart - pSelEnd
Case Is < pSelEnd
pSelEnd = .Value
.SelStart = pSelEnd
.SelLength = pSelStart - pSelEnd
End Select
End Select
Else
Select Case pSelEnd
Case Is >= pSelStart
Select Case .Value
Case Is < pSelStart
.Value = pSelStart
Case Is > pSelEnd
.Value = pSelEnd
End Select
.SelStart = pSelStart
.SelLength = pSelEnd - pSelStart
Case Is < pSelStart
Select Case .Value
Case Is > pSelStart
.Value = pSelStart
Case Is < pSelEnd
.Value = pSelEnd
End Select
.SelStart = pSelEnd
.SelLength = pSelStart - pSelEnd
End Select
End If
End Select
End With
RaiseEvent Scroll
sInProc = False
End Sub
|