ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 28.06.2000

Diese Seite wurde zuletzt aktualisiert am 28.06.2000
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicAddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zur AVB-Web-Site, Kontakt und Impressum

Zurück...

Zurück...


Anzeige

(-hg) mailto:hg_fontgroup@aboutvb.de

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.


Von mehreren Steuerelementen gemeinsam genutzte Font-Objekte

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

Der Code der Klasse FontGroup

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?"Parameter-Anzahl unbekannt?").

Wenn auch die Klasse FontGroup und das Steuerelement FontGroupCtl (Code des Controls FontGroupCtlCode) 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...


Code des Controls FontGroupCtl Code des Controls SizeGrip

Das Projekt FontGroupOCX (fontgroup.zip - ca. 9 KB)

ActiveX-Control als Setup (ohne VB 6-Runtime!) (fontgroups.zip - ca. 269 KB)



Komponenten-Übersicht

Schnellsuche



Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer