|
Solange Sie es dabei bewenden lassen, nur seine Eigenschaften zu
setzen oder auszulesen, ist das Font-Objekt eines Steuerelements
völlig harmlos. 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 beliebig vielen Steuerelementen ein und dasselbe
Font-Objekt zuweisen. Damit können Sie sicherstellen, dass die
Font-Einstellungen bei diesen Steuerelemente immer gleich ist - jede
Änderung der Font-Eigenschaften wirkt sich auf alle diese
Steuerelemente zugleich aus.
Sie können die Verwaltung einer solchen Gruppe von
Steuerelementen und die Zuweisung eines gemeinsamen Font-Objekts in
einer Klasse organisieren. Die betreffenden Steuerelemente werden
einfach bei dieser Klasse angemeldet und gegebenenfalls auch wieder
dort abgemeldet. Bei der Anmeldung wird ihnen das in der Klasse
festgelegte Font-Objekt zugewiesen, bei der Abmeldung wird das
ursprüngliche Font-Objekt restauriert.
Die hier vorgestellte Klasse FontGroup verwaltet über das
gemeinsame Font-Objekt hinaus auch noch eine gemeinsame
Schriftfarbe. Und sie enthält auch die in  "Font-Vorlagen
sammeln" vorgestellte Klasse FontTemplates zur Ablage von
verschieden konfigurierten Font-Objekten.
Das gemeinsame Font-Objekt, das von der Klasse FontGroup
verwaltet wird, weisen Sie über die Font-Eigenschaft zu. Hier gibt
es eine kleine Besonderheit. Verwenden Sie bei der Zuweisung das
Set-Schlüsselwort, wird das übergebene Font-Objekt zum neuen
gemeinsamen Font-Objekt (Property Set-Prozedur). Lassen
Sie hingegen das Set-Schlüsselwort weg, werden nur die
Einstellungen der Eigenschaften des übergebenen Font-Objekts in das
bereits vorhandene (bzw. erstmals neu angelegte) Font-Objekt
übertragen (Property Let-Prozedur). Über die Methode
SelectFontTemplate können Sie alternativ zur Zuweisung eines
externen Font-Objekts eines aus den in der Unterklasse FontTemplates
abgelegten Vorlagen-Font-Objekten auswählen.
Über die Methode AttachControls können Sie nun Steuerelemente
anmelden. Da der Übergabe-Parameter als ParamArray angelegt ist,
können Sie beliebig viele Steuerelemente mit einem einzigen Aufruf
anmelden. Das Abmelden erfolgt über die Methode DetachControls.
Auch hier können Sie wieder beliebig viele Steuerelemente zugleich
übergeben. Geben Sie dagegen kein einziges Steuerelement an, werden
automatisch alle angemeldeten abgemeldet. Die Anzahl der aktuell
angemeldeten Steuerelemente liefert Ihnen die Eigenschaft
CountAttached.
Sollten Sie vor dem Anmelden des ersten Steuerelements noch kein
Font-Objekt zugewiesen oder aus den Vorlagen ausgewählt haben, wird
automatisch das Font-Objekt des ersten angemeldeten Steuerelements
als gemeinsames Font-Objekt übernommen. Sie können natürlich
nachträglich wieder ein anderes Font-Objekt zuweisen bzw.
auswählen.
Private mControlItems As Collection
Public Enum FontGroupErrorConstants
fgErrControlNoAttached = vbObjectError + 10000
fgErrNoFontAvailable = vbObjectError + 10001
fgErrInvalidTemplateKeyIndex = vbObjectError + 10002
End Enum
Private pFont As StdFont
Private pFontTemplates As FontTemplates
Private pForeColor As OLE_COLOR
Public Property Get CountAttached() As Long
If Not (mControlItems Is Nothing) Then
CountAttached = mControlItems.Count
End If
End Property
Public Property Get Font() As StdFont
If pFont Is Nothing Then
Err.Raise fgErrNoFontAvailable, "Font [Get]"
Else
Set Font = pFont
End If
End Property
Public Property Let Font(New_Font As StdFont)
If pFont Is Nothing Then
Set pFont = New StdFont
End If
With pFont
.Bold = New_Font.Bold
.Charset = New_Font.Charset
.Italic = New_Font.Italic
.Name = New_Font.Name
.Size = New_Font.Size
.Strikethrough = New_Font.Strikethrough
.Underline = New_Font.Underline
.Weight = New_Font.Weight
End With
End Property
Public Property Set Font(New_Font As StdFont)
Dim nControlItem As Variant
Dim nOldFont As StdFont
If Not (pFont Is New_Font) Then
Set nOldFont = pFont
Set pFont = New_Font
If Not (mControlItems Is Nothing) Then
On Error Resume Next
For Each nControlItem In mControlItems
With nControlItem(0)
If .Font Is nOldFont Then
Set .Font = pFont
.Refresh
End If
End With
Next
End If
End If
End Property
Public Property Get FontTemplates() As FontTemplates
Set FontTemplates = pFontTemplates
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = pForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
Dim nControlItem As Variant
Dim nOldForeColor As Long
If pForeColor <> New_ForeColor Then
nOldForeColor = pForeColor
pForeColor = New_ForeColor
If Not (mControlItems Is Nothing) Then
On Error Resume Next
For Each nControlItem In mControlItems
With nControlItem(0)
If .ForeColor = nOldForeColor Then
.ForeColor = pForeColor
.Refresh
End If
End With
Next
End If
End If
End Property
Public Sub AttachControls(ParamArray Controls() As Variant)
Dim nControlItem As Variant
Dim nForeColor As Long
Dim nControl As Variant
Dim nFont As StdFont
Dim nControls As Variant
If pFont Is Nothing Then
Err.Raise fgErrNoFontAvailable, "AttachControl"
End If
If mControlItems Is Nothing Then
Set mControlItems = New Collection
End If
If IsArray(Controls(0)) Then
nControls = Controls(0)
Else
nControls = Controls
End If
On Error Resume Next
For Each nControl In nControls
nControlItem = mControlItems(CStr(ObjPtr(nControl)))
If Err.Number Then
Err.Clear
With nControl
Set nFont = .Font
nForeColor = .ForeColor
If Err.Number Then
Err.Clear
nForeColor = vbWindowText
End If
mControlItems.Add Array(nControl, nFont, nForeColor), _
CStr(ObjPtr(nControl))
If pFont Is Nothing Then
Set pFont = nFont
Else
Set .Font = pFont
End If
.ForeColor = pForeColor
.Refresh
End With
End If
Next
End Sub
Public Sub DetachControls(ParamArray Controls() As Variant)
Dim nControls As Variant
Dim nControl As Variant
Dim nControlItem As Variant
If Not (mControlItems Is Nothing) Then
If IsArray(Controls(0)) Then
nControls = Controls(0)
Else
nControls = Controls
End If
If UBound(nControls) = -1 Then
On Error Resume Next
For Each nControlItem In mControlItems
With nControlItem(0)
Set .Font = nControlItem(1)
.ForeColor = nControlItem(2)
.Refresh
End With
Next
Set mControlItems = Nothing
Else
On Error Resume Next
For Each nControl In nControls
nControlItem = mControlItems(CStr(ObjPtr(nControl)))
If Err.Number Then
Err.Raise fgErrControlNoAttached, "DetachControl", _
nControl.Name
Else
With nControl
If .Font Is pFont Then
Set .Font = nControlItem(1)
.ForeColor = nControlItem(2)
.Refresh
End If
End With
mControlItems.Remove CStr(ObjPtr(nControl))
End If
Next
If mControlItems.Count = 0 Then
Set mControlItems = Nothing
End If
End If
End If
End Sub
Public Sub SelectFontTemplate(KeyIndex As Variant)
On Error Resume Next
Set Me.Font = pFontTemplates(KeyIndex)
If Err.Number Then
Err.Raise fgErrInvalidTemplateKeyIndex, "SelectFontTemplate", _
KeyIndex
End If
End Sub
Private Sub Class_Initialize()
pForeColor = vbWindowText
Set pFontTemplates = New FontTemplates
End Sub
Private Sub Class_Terminate()
Set pFontTemplates = Nothing
Set mControlItems = Nothing
Set pFont = Nothing
End Sub
Vielleicht ist Ihnen beim Betrachten des obenstehenden Codes der
Klasse FontGroup in den Methoden AttachControls und DetachControls
die etwas seltsam erscheinende Art und Weise der Auswertung des
ParamArrays aufgefallen. Diese hat jedoch ihren guten Grund. Das
Projekt, in dem sich die Klasse FontGroup befindet, enthält
nämlich auch noch das Steuerelement FontGroupCtl. Dieses stellt
lediglich eine Hülle um die Klasse FontGroup dar und verfügt daher
ebenfalls über die Methoden AttachControls und DetachControls mit
ParamArrays. Beim Weiterreichen des ParamArrays vom UserControl an
die Klasse kommt dort nur ein Parameter an, nämlich als Array im
ersten Element des dortigen ParamArrays. Daher muss in der Klasse
unterschieden werden, ob das erste Element des ParamArrays oder das
ParamArray als Ganzes ausgewertet werden soll. Bei der Methode
DetachControls kommt noch hinzu, dass beim UserControl
gegebenenfalls gar kein Steuerelement übergeben wird (zum
kompletten Abmelden aller angemeldeten Steuerelemente). In der
Klasse kommt jedoch trotzdem ein Array an, wenn auch ein leeres, was
anhand der Obergrenze -1 erkenntlich ist (siehe dazu
auch  "Parameter-Anzahl
unbekannt?").
Wenn auch die Klasse FontGroup und das Steuerelement FontGroupCtl
(Code)
funktional gleichwertig sind, hat das Steuerelement den Vorteil,
dass Sie das gemeinsame Font-Objekt und dessen Eigenschaften bereits
zur Entwicklungszeit festlegen und visuell prüfen können. Bei
einem auf die Steuerelemente eines Forms beschränkten gemeinsamen
Font-Objekt ist das sicher die komfortablere Wahl. Soll das
gemeinsame Font-Objekt jedoch möglicherweise projektweit für
Steuerelemente mehrerer Forms gelten, könnte eine Trennung von
einem bestimmten Form sinnvoller sein. In diesem Fall bietet sich
die Verwendung der Klasse an. Dazu können Sie die OCX auch einfach
als Verweis in das Projekt einbinden und brauchen es nicht in die
Werkzeugsammlung laden. Die Anmeldung von Steuerelementen, die auf
verschiedenen Forms (und auch eigenen im Projekt enthaltenen
UserControls) platziert sind, ist problemlos möglich.
Übrigens lässt sich das Ganze nur unter Visual Basic 6
kompilieren. Denn Steuerelement-Projekte können in Visual Basic
5 keine instanzierbaren öffentlichen Klassen enthalten. Es
wäre zwar möglich, auf die Klasse verzichten und alles direkt im
UserControl zu implementieren. Doch ist mir bei dem Versuch die
VB-Entwicklungsumgebung ständig abgestürzt - aus welchem Grund
auch immer, ich habe da kein nachvollziehbares System hinter den
Abstürzen feststellen können. Sie können es gerne selbst auch
einmal unter Visual Basic 5 versuchen - aber dann bitte
auf eigene Gefahr...
|