|
Das UpDown-Steuerelement aus den Microsoft Common Controls 2 ermöglicht nur ganzzahlige Werte, Schrittweiten und Unter- und Obergrenzen. Wie wäre es dagegen mit einem Steuerelement dieser Art (auch "Spin"-Steuerelemente genannt), dessen Wert, Schrittweite und Grenzen beliebige Werte des Datentyps Decimal sein können? Decimal ist ein Unterdatentyp von Variant und kann extrem große Werte von bis zu 29 Stellen vor dem Komma oder extrem kleine Werte bis zu 28 Stellen nach dem Komma annehmen.
Der Trick ist eigentlich ganz einfach. Sie nehmen eine vertikale Scrollbar und bringen sie auf die Höhe etwa einer TextBox. Damit entspricht ihr Aussehen schon mal dem des UpDown-Steuerelements. Dann setzen Sie als Min-Wert -1, als Max-Wert 1, als SmallChange 1 und als Value 0. LargeChange bleibt unberührt auf 1, da die große Schrittweite bei einer so geschrumpften Scrollbar sowieso nicht zum Tragen kommt. Für den aktuellen Wert, die Schrittweite und die Grenzen deklarieren Sie separate Variant-Variablen. Im Change-Ereignis der Scrollbar prüfen Sie nun nur noch das Vorzeichen der Value-Eigenschaft über die Sgn-Funktion. Ist es positiv (Sgn liefert 1), addieren Sie die Schrittweite zum aktuellen Wert, ist es negativ (Sgn liefert -1), subtrahieren Sie die Schrittweite. Die Value-Eigenschaft der Scrollbar setzen Sie sogleich wieder auf 0. Zwar wird dadurch erneut das Change-Ereignis ausgelöst. Doch ja Sgn nun 0 zurückgibt, ignorieren Sie diese Auslösung. Dieses ständige Umschalten des Wertes der Scrollbar zwischen 0 und +1 bzw. -1 funktioniert auch einwandfrei bei Dauerfeuer - wenn der Anwender die Maustaste auf einer der beiden Scrollflächen niedergedrückt lässt.
Natürlich müssen Sie dazu noch prüfen, ob der neu berechnete Wert die Grenzen unter- bzw. überschreitet und ihn gegebenenfalls auf den unteren oder oberen Grenzwert beschränken. Auch sind Prüfungen sinnvoll, ob ein neu gesetzter Max-Wert tatäschlich größer als der Min-Wert ist, und ob auch nach der Änderung einer der Grenzen der aktuelle Wert noch innerhalb derselben liegt. Auch ergibt es keinen Sinn, eine Schrittweite zu setzen, die größer als die Differenz zwischen Ober- und Untergrenze wäre. Und wenn Sie dann den Wert auch noch formatiert ausgeben möchten...
...ist das Grund genug, ein eigenständiges Steuerelement auf der Basis eines UserControls zu entwickeln und alle diese Berechnungen und Prüfungen darin zu verpacken. Nun ist es auch ein Leichtes, noch ein paar praktische Features hinzuzufügen.
So ist die Frage durchaus bedenkenswert, welchen Wert unser Steuerelement annehmen soll, wenn bei "krummen" Schrittweiten die Grenzen überschritten würden. Soll der Wert dann auf die jeweilige Grenze gesetzt werden? Oder soll der letzte Wert beibehalten werden? Die Eigenschaften MinBoundary und MaxBoundary legen dies fest. Sind sie auf True gesetzt, wird der Wert auf die Grenze gesetzt.
Ein weiteres Feature, das wir gleich und ohne Aufwand einfügen können, ist die Ausgabe des Wertes als formatierter Text. Während die Eigenschaft Value immer den Variant-Wert zurückgibt, liefert die Eigenschaft ValueFormat den Wert in dem Format, das in der Eigenschaft Format angegeben ist. Ist dort nur ein leerer String angegeben, gibt auch ValueFormat den Wert unformatiert zurück, allerdings als Variant-Datentyp String. Als Format können Sie alle Formatierungs-Strings und benannten Formate angeben, die auch in der Standard-Format-Funktion in VB/VBA möglich sind.
Jede Änderung des Wertes wird über das Ereignis Change (das einzige Ereignis des Steuerelements) gemeldet. Der Einfachheit halber übergibt es im Parameter Value gleich den aktuellen Wert. Ist die Eigenschaft FormattedEvent gesetzt, enthält der Parameter den entsprechend der Format-Eigenschaft formatierten Wert als String, ansonsten den Variant-Wert.
Natürlich können Sie jederzeit die Value-Eigenschaft auf einen beliebigen Wert setzen. Sie können die Erhöhung oder Verminderung des Wertes aber auch über die Methoden Incr und Decr vornehmen und dabei die Anzahl der Schritte optional übergeben (Voreinstellung ist 1).
Public Event Change(Value As Variant)
Private pFormat As String
Private pFormattedEvent As Boolean
Private pMax As Variant
Private pMaxBoundary As Boolean
Private pMin As Variant
Private pMinBoundary As Boolean
Private pStep As Variant
Private pValue As Variant
Public Property Get Format() As String
Format = pFormat
End Property
Public Property Let Format(New_Format As String)
Dim nValueFormat As String
If pFormat <> New_Format Then
pFormat = New_Format
On Error Resume Next
nValueFormat = Me.ValueFormat
If Err.Number Then
On Error GoTo 0
Err.Raise 380
Else
PropertyChanged "Format"
End If
zRaiseEvent
End If
End Property
Public Property Get FormattedEvent() As Boolean
FormattedEvent = pFormattedEvent
End Property
Public Property Let FormattedEvent(New_FormattedEvent As Boolean)
If pFormattedEvent <> New_FormattedEvent Then
pFormattedEvent = New_FormattedEvent
zRaiseEvent
PropertyChanged "FormattedEvent"
End If
End Property
Public Property Get MaxBoundary() As Boolean
MaxBoundary = pMaxBoundary
End Property
Public Property Let MaxBoundary(New_MaxBoundary As Boolean)
pMaxBoundary = New_MaxBoundary
PropertyChanged "MaxBoundary"
End Property
Public Property Get Max() As Variant
Max = pMax
End Property
Public Property Let Max(Max As Variant)
Dim nMax As Variant
On Error Resume Next
nMax = CDec(Max)
If Err.Number Then
On Error GoTo 0
Err.Raise 380
ElseIf pMax <> nMax Then
pMax = nMax
If pValue > pMax Then
Me.Value = pMax
End If
If pMax < pMin Then
pMax = pMin
Err.Raise 380
End If
PropertyChanged "Max"
End If
End Property
Public Property Get Min() As Variant
Min = pMin
End Property
Public Property Let Min(Min As Variant)
Dim nMin As Variant
On Error Resume Next
nMin = CDec(Min)
If Err.Number Then
On Error GoTo 0
Err.Raise 380
ElseIf pMin <> nMin Then
pMin = nMin
If pValue < pMin Then
Me.Value = pMin
End If
If pMin > pMax Then
pMin = pMax
Err.Raise 380
End If
PropertyChanged "Min"
End If
End Property
Public Property Get MinBoundary() As Boolean
MinBoundary = pMinBoundary
End Property
Public Property Let MinBoundary(New_MinBoundary As Boolean)
pMinBoundary = New_MinBoundary
PropertyChanged "MinBoundary"
End Property
Public Property Get Step() As Variant
Step = pStep
End Property
Public Property Let Step(Step As Variant)
Dim nStep As Variant
On Error Resume Next
nStep = CDec(Step)
If Err.Number Then
On Error GoTo 0
Err.Raise 380
Else
If nStep <= 0 Then
Err.Raise 380
Else
pStep = nStep
If pStep > (pMax - pMin) Then
pStep = pMax - pMin
Err.Raise 380
End If
PropertyChanged "Step"
End If
End If
End Property
Public Property Get Value() As Variant
Value = pValue
End Property
Public Property Let Value(Value As Variant)
Dim nValue As Variant
Dim nOldValue As Variant
On Error Resume Next
nValue = CDec(Value)
If Err.Number Then
On Error GoTo 0
Err.Raise 380
ElseIf pValue <> nValue Then
nOldValue = pValue
pValue = nValue
Select Case pValue
Case Is < pMin
If pMinBoundary Then
pValue = pMin
Else
pValue = pValue + pStep
End If
Case Is > pMax
If pMaxBoundary Then
pValue = pMax
Else
pValue = pValue - pStep
End If
End Select
If pValue <> nOldValue Then
zRaiseEvent
PropertyChanged "Value"
End If
End If
End Property
Public Property Get ValueFormat() As String
If Len(pFormat) Then
On Error Resume Next
ValueFormat = VBA.Format$(pValue, pFormat)
Else
ValueFormat = CStr(pValue)
End If
End Property
Public Sub Decr(Optional ByVal Steps As Long = 1)
Select Case Steps
Case Is > 0
Me.Value = pValue - Steps * pStep
Case Else
Err.Raise 5
End Select
End Sub
Public Sub Incr(Optional ByVal Steps As Long = 1)
Select Case Steps
Case Is > 0
Me.Value = pValue + Steps * pStep
Case Else
Err.Raise 5
End Select
End Sub
Private Sub vs_Change()
Dim nSgn As Integer
Static sInProc As Boolean
If sInProc Then
Exit Sub
Else
sInProc = True
End If
With vs
nSgn = Sgn(.Value)
.Value = 0
On Error Resume Next
Select Case nSgn
Case 0
Case -1
Me.Value = CDec(pValue) - CDec(pStep)
Case 1
Me.Value = CDec(pValue) + CDec(pStep)
End Select
End With
sInProc = False
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
With UserControl
vs.Move 0, 0, .ScaleWidth, .ScaleHeight
End With
End Sub
Private Sub UserControl_Initialize()
pMax = 100
pStep = 1
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
pFormat = .ReadProperty("Format", "")
pFormattedEvent = .ReadProperty("FormattedEvent", False)
pMax = .ReadProperty("Max", 100)
pMaxBoundary = .ReadProperty("MaxBoundary", False)
pMin = .ReadProperty("Min", 0)
pMinBoundary = .ReadProperty("MinBoundary", False)
pStep = .ReadProperty("Step", 1)
pValue = .ReadProperty("Value", 0)
End With
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
.WriteProperty "Format", pFormat, ""
.WriteProperty "FormattedEvent", pFormattedEvent, False
.WriteProperty "Max", pMax, 100
.WriteProperty "MaxBoundary", pMaxBoundary, False
.WriteProperty "Min", pMin, 0
.WriteProperty "MinBoundary", pMinBoundary, False
.WriteProperty "Step", pStep, 1
.WriteProperty "Value", pValue, 0
End With
End Sub
Private Sub zRaiseEvent()
If pFormattedEvent Then
RaiseEvent Change(Me.ValueFormat)
Else
RaiseEvent Change(pValue)
End If
End Sub
|