|
Das  Font-Objekt
eines Steuerelements ist an sich ganz harmlos - solange Sie es dabei
bewenden lassen, nur seine Eigenschaften zu setzen oder auszulesen.
Sobald Sie jedoch mit Font-Objekt eines Steuerelements selbst zu
hantieren beginnen, etwa indem Sie es der Font-Eigenschaft eines
anderen Steuerelements zuweisen, können die sich einstellenden
Effekte leicht verwirren. Denn dabei übertragen Sie nicht nur die
aktuellen Font-Einstellungen vom einen Steuerelement zum anderen.
Vielmehr teilen sich danach beide Steuerelemente ein und dasselbe
Font-Objekt. Sobald Sie nun den Wert einer Font-Eigenschaft bei
einem der beiden Steuerelemente ändern, wirkt sich die Änderung
auch auf das andere Steuerelement aus. Dieses Verhalten, das Sie in
gewissem Sinne auch als "Vererbung" betrachten können,
lässt sich auch gezielt nutzen.
So können Sie zum Beispiel Font-Objekte mit verschiedenen
Einstellungen in einer Collection
ablegen und als Vorlagen einer Reihe von Steuerelementen zuweisen.
Sie können dazu eine einfache Visual Basic-Collection verwenden.
Wenn Sie jedoch eine spezielle Collection anlegen, können Sie diese
um ein paar nützliche Features erweitern.
Die folgende Klasse FontTemplates stellt eine solche
Vorlagen-Collection dar. Wie jede Collection verfügt sie über die
Standard-Eigenschaften und -Methoden Count, Item, Add, Clear, Remove
und NewEnum (letztere, um eine For...Each-Schleife
anwenden zu können).
Darüber hinaus gibt es noch die Eigenschaft SelectedFont, die
den zuletzt über die Funktion Item abgerufenen Font als aktuell
gewählten Font festhält.
Public Property Get SelectedFont() As StdFont
Set SelectedFont = pSelectedFont
End Property
Public Function Item(KeyIndex As Variant) As StdFont
Dim nFont As StdFont
On Error Resume Next
Set nFont = mFonts(KeyIndex)
If Err.Number Then
Err.Raise fgtErrInvalidKeyIndex, "Item", KeyIndex
End If
Set pSelectedFont = nFont
Set Item = nFont
End Function
Aus diesem Grund ist Item hier nicht wie Üblich als Eigenschaft
(Property Get) sondern als Funktion angelegt, damit Sie die Prozedur
auch ohne Rückgabewert nutzen können:
FontTemplates "Schlüssel"
Einige Besonderheiten bietet die Add-Methode. Über sie können
Sie wie üblich ein vorhandenes Font-Objekt unter einem Schlüssel
ablegen (Übergeben Sie als Schlüssel versehentlich einen leeren
String, wird ein Laufzeitfehler ausgelöst). Sie können aber auch
das in die Collection einzufügende Font-Objekt erst neu
instanzieren lassen, indem Sie den Parameter Font weglassen.
Übergeben dann Sie im weiteren optionalen Parameter InheritFrom
einen Schlüssel oder Index, der auf ein bereits in der Sammlung
vorhandenes Font-Objekt verweist, erbt das neu instanzierte
Font-Objekt dessen Einstellungen.
Public Function Add(Key As String, Optional Font As StdFont, _
Optional InheritFrom As Variant) As StdFont
Dim nFont As StdFont
Dim nInheritedFont As StdFont
If Len(Key) = 0 Then
Err.Raise fgtErrInvalidKeyIndex, "Add", Key
End If
If Font Is Nothing Then
Set nFont = New StdFont
If Not IsMissing(InheritFrom) Then
On Error Resume Next
Set nInheritedFont = Me.Item(InheritFrom)
If Err.Number Then
Err.Raise fgtErrInvalidInheritedFont, "Add"
Else
With nFont
.Bold = nInheritedFont.Bold
.Charset = nInheritedFont.Charset
.Italic = nInheritedFont.Italic
.Name = nInheritedFont.Name
.Size = nInheritedFont.Size
.Strikethrough = nInheritedFont.Strikethrough
.Underline = nInheritedFont.Underline
.Weight = nInheritedFont.Weight
End With
End If
End If
Else
Set nFont = Font
End If
On Error Resume Next
mFonts.Add nFont, Key
If Err.Number Then
Err.Raise fgtErrInvalidKeyIndex, "Add", Key
Else
Set Add = nFont
End If
End Function
Ein weiteres kleines Feature bietet die Remove-Methode. In deren
Parameter KeyIndexFont können Sie nicht nur den Schlüssel bzw. den
Index des aus der Collection zu entfernenden Font-Objekts angeben,
sondern sogar direkt ein Font-Objekt. Ist dieses in der Collection
enthalten, wird es daraus entfernt.
Public Sub Remove(KeyIndexFont As Variant)
Dim l As Long
If IsObject(KeyIndexFont) Then
If TypeOf KeyIndexFont Is StdFont Then
With mFonts
For l = 1 To .Count
If mFonts(l) Is KeyIndexFont Then
.Remove l
Exit Sub
End If
Next 'l
Err.Raise fgtErrInvalidKeyIndex, "Remove", "Font-Object"
End With
Else
Err.Raise fgtErrInvalidKeyIndex, "Remove", TypeName(KeyIndexFont)
End If
Else
On Error Resume Next
mFonts.Remove KeyIndexFont
If Err.Number Then
Err.Raise fgtErrInvalidKeyIndex, "Remove", KeyIndexFont
End If
End If
End Sub
Der übrige Code der Klasse ist reiner Standard:
Private mFonts As Collection
Private pSelectedFont As StdFont
Public Enum FontTemplatesErrorConstants
fgtErrInvalidKeyIndex = vbObjectError + 11000
fgtErrInvalidInheritedFont = vbObjectError + 11001
End Enum
Public Property Get Count() As Long
Count = mFonts.Count
End Property
Public Sub Clear()
Set mFonts = New Collection
Set pSelectedFont = Nothing
End Sub
Public Function NewEnum() As IUnknown
Set NewEnum = mFonts.[_NewEnum]
End Function
Private Sub Class_Initialize()
Set mFonts = New Collection
End Sub
Private Sub Class_Terminate()
Set pSelectedFont = Nothing
Set mFonts = Nothing
End Sub
|