(-hg) 

Je mehr Eigenschaften ein Steuerelement bietet, um so größer ist die Vielzahl der Kombinationen dieser Einstellungen. Was zunächst nur nach einer bloßen Binsenweisheit klingt, sorgt jedoch oft genug für viel Fummelei und Arbeit, und hat auch Ihnen wahrscheinlich schon so manchen (stillen) Fluch entlockt. Denn garantiert müssen Sie gerade Ihre Lieblingskombination der Eigenschaften-Einstellungen jedes Mal erst mit einer Vielzahl an Mausklicks und Eingaben zustande bringen. Oder Sie experimentieren mit verschiedenen Kombinationen und möchten die eine oder andere darunter vorübergehend festhalten und sich erst später endgültig für eine entscheiden. Wäre es da nicht praktisch, wenn Sie solche Kombinationen zur Auswahl zwischenspeichern oder in einer Datei speichern, oder gar ganze Sätze solcher Kombinationen in einer Datei ablegen und wieder nach Bedarf hervor holen könnten?

Freuen Sie sich aber bitte nicht zu früh! In diesem Artikel biete ich Ihnen keine Lösung für beliebige Steuerelemente an - das wäre beispielsweise mit einem relativ aufwändigen AddIn für die VB-Entwicklungsumgebung zu realisieren.

Mit nur minimalem Aufwand können Sie jedoch Ihre selbstgeschriebenen Steuerelemente mit einem derartigen Komfort versehen. Ein wenig Zauberei mit dem PropertyBag-Objekt und dazu der Trick mit den Aktions-Eigenschaften (siehe "'Wahl'lose Aktions-Eigenschaften") - so viel gehört gar nicht dazu.

	Verschiedene Kombinationen von Eigenschaften-Einstellungen sammlen, ablegen und speichern

Der erste Schritt ist das Speichern eines Sets der aktuellen Eigenschaften-Einstellungen. Üblicherweise werden diese im UserControl_WriteProperties-Ereignis in ein PropertyBag-Objekt geschrieben. Beim Speichern des Containers (Forms) erzeugt Visual Basic selbst ein PropertyBag-Objekt, ruft die UserControl_WriteProperties-Ereignisprozedur auf und übergibt dabei dieses PropertyBag-Objekt. Seit Visual Basic 6 können Sie allerdings ein PropertyBag-Objekt selbst instanzieren und einem Aufruf dieser Prozedur übergeben. Dort werden die aktuellen Einstellungen der Eigenschaften genauso hineingeschrieben.

Private mBag As PropertyBag

Public Property Get Store() As Boolean
  '
End Property

Public Property Let Store(New_Store As Boolean)
  Set mBag = New PropertyBag
  UserControl_WriteProperties mBag
End Property
  
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "EigenschaftXY", Wert
  ' ...
End Sub

Der umgekehrte Weg erfordert sogar noch etwas weniger Aufwand:

Public Property Get Restore() As Boolean
  '
End Property

Public Property Let Restore(New_Restore As Boolean)
  UserControl_ReadProperties mBag
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  Wert = PropBag.ReadProperty("EigenschaftXY", Wert)
  ' ...
End Sub

Somit hätten Sie nun schon genau einen Satz an Eigenschaften-Einstellungen, den Sie jederzeit füllen und wiederherstellen können. Wenn Sie nun nicht nur ein einziges PropertyBag-Objekt verwenden, sondern bei jedem Speichern den jeweiligen Satz in einem neuen PropertyBag-Objekt speichern und dieses in einer Collection ablegen, brauchen Sie nur noch für die Möglichkeit zum Durchblättern und/oder Auswählen der abgelegten Sätze sorgen. Zunächst das Speichern:

Private mBags As Collection
Private mBagsSet As Long

Public Property Get Store() As Boolean
'
End Property

Public Property Let Store(New_Store As Boolean)
  Dim nBag As PropertyBag
  
  Set nBag = New PropertyBag
  UserControl_WriteProperties nBag
  nBag.WriteProperty "§", True, False
  If mBags Is Nothing Then
    Set mBags = New Collection
  End If
  mBags.Add nBag
  mBagsSet = mBags.Count
  PropertyChanged "Store"
End Property

Der zusätzlich in dem PropertyBag-Objekt abgelegte Wert mit dem Schlüssel "§" dient der UserControl_ReadProperties- und der UserControl_WriteProperties-Prozedur zur Unterscheidung Ihrer PropertyBag-Objekt vom VB-eigenen PropertyBag-Objekt bzw. den Sammel-PropertyBag-Objekten, die Sie später zur Speicherung in einer Datei verwenden werden.

Selbstverständlich lassen sich auch die abgelegten Sets wiederum mit speichern, auch im VB-eigenen PropertyBag-Objekt, so dass einmal abgelegte Sätze auch nach dem Schließen und Wiederöffnen des Containers zur Verfügung stehen.

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Dim l As Long
  
  If Not PropBag.ReadProperty("§", False) Then
    If Not (mBags Is Nothing) Then
      With mBags
        PropBag.WriteProperty "Count", .Count, 0
        For l = 1 To .Count
          PropBag.WriteProperty "§" & l, mBags(l).Contents
        Next 'l
      End With
      PropBag.WriteProperty "§Set", mBagsSet, 0
    End If
  End If
  
  PropBag.WriteProperty "EigenschaftXY", Wert
  '...
End Sub

Nun wieder der Rückwärtsgang - Sie können nun in der Sammlung der PropbertyBag-Objekte auf und ab blättern oder ein bestimmtes Set auswählen. Hier dienen die Aufrufe der Property Get-Prozeduren zur Anzeige, ob in die eine oder andere Richtung noch weiter geblättert werden kann bzw. welches Set gerade gewählt ist.

Public Property Get RestoreDown() As Boolean
  If Not (mBags Is Nothing) Then
    RestoreDown = CBool(mBagsSet > 1)
  End If
End Property

Public Property Let RestoreDown(New_RestoreDown As Boolean)
  If Not (mBags Is Nothing) Then
    If mBags.Count Then
      If mBagsSet > 1 Then
        mBagsSet = mBagsSet - 1
        UserControl_ReadProperties mBags(mBagsSet)
      End If
    End If
  End If
  PropertyChanged "RestoreDown"
End Property

Public Property Get RestoreUp() As Boolean
  If Not (mBags Is Nothing) Then
    RestoreUp = CBool(mBagsSet < mBags.Count)
  End If
End Property

Public Property Let RestoreUp(New_RestoreUp As Boolean)
  If Not (mBags Is Nothing) Then
    If mBags.Count Then
      If mBagsSet < mBags.Count Then
        mBagsSet = mBagsSet + 1
        UserControl_ReadProperties mBags(mBagsSet)
      End If
    End If
  End If
  PropertyChanged "RestoreUp"
End Property

Public Property Get RestoreSet() As Long
  RestoreSet = mBagsSet
End Property

Public Property Let RestoreSet(New_RestoreSet As Long)
  If Not (mBags Is Nothing) Then
    With mBags
      Select Case New_RestoreSet
        Case 0
          UserControl_ReadProperties mBags(mBagsSet)
        Case 1 To .Count
          UserControl_ReadProperties mBags(New_RestoreSet)
          mBagsSet = New_RestoreSet
        Case Else
          Err.Raise 380
      End Select
    End With
  End If
  PropertyChanged "RestoreSet"
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  Dim l As Long
  Dim nCount As Long
  Dim nBag As PropertyBag
  
  If Not PropBag.ReadProperty("§", False) Then
    nCount = PropBag.ReadProperty("Count", 0)
    If nCount Then
      Set mBags = New Collection
      For l = 1 To nCount
        Set nBag = New PropertyBag
        nBag.Contents = PropBag.ReadProperty("§" & l)
        mBags.Add nBag
      Next 'l
      mBagsSet = PropBag.ReadProperty("§Set", 0)
    Else
      §B_Store = True
    End If
  End If

  Wert = PropBag.ReadProperty("EigenschaftXY", "")
  '...
End Sub

Nun möchten Sie sicher auch gerne gelegentlich den einen oder anderen abgelegten Eigenschaften-Satz wieder loswerden, oder alle Sätze löschen.

Public Property Get RemoveSet() As Boolean
  If Not (mBags Is Nothing) Then
    RemoveSet = CBool(mBags.Count)
  End If
End Property

Public Property Let RemoveSet(New_RemoveSet As Boolean)
  If Not (mBags Is Nothing) Then
    With mBags
      .Remove mBagsSet
      Select Case .Count
        Case Is < mBagsSet
          mBagsSet = .Count
      End Select
    End With
  End If
  PropertyChanged "RemoveSet"
End Property

Public Property Get ClearAll() As Boolean
  If Not (mBags Is Nothing) Then
    ClearAll = CBool(mBags.Count)
  End If
End Property

Public Property Let ClearAll(New_ClearAll As Boolean)
  Set mBags = New Collection
  mBagsSet = 0
  PropertyChanged "ClearAll"
End Property

Drehen Sie das Prinzip der Schalter-Eigenschaft herum und verwenden lediglich die Prroperty Get-Prozedur, können Sie dies zur Anzeige der aktuellen Anzahl der abgelegten Sets verwenden. Ein Setzen des Wertes im Eigenschaften-Fenster wäre zwar möglich, zeigt aber einfach keine Wirkung.

Public Property Get Count() As Long
  Count = mBags.Count
End Property

Public Property Let Count(New_Count As Long)
'
End Property

Auch beim Speichern in einer Datei und beim Wiederauslesen lassen Sie die Hauptarbeit die sowieso vorhandenen Ereignis-Prozeduren UserControl_WriteProperties und UserControl-ReadProperties erledigen. Sie benötigen lediglich noch den Dateiauswahl-Dialog aus den Common Dialogs. Nachdem Sie wieder über UserControl_WriteProperties die Eigenschaftenwerte eingesammelt haben, schreiben Sie noch eine Kennung hinzu, damit beim Einlesen die Sets zu anderen Steuerelementen abgewiesen werden können.

Public Property Get SaveSets() As Boolean
  '
End Property

Public Property Let SaveSets(New_Save As Boolean)
  Dim nVar As Variant
  Dim nBag As PropertyBag
  Dim nFNr As Integer
  
  With CommonDialog1
    .CancelError = True
    .DialogTitle = "Vorlagen-Sets speichern"
    .DefaultExt = "§§§"
    .Filter = "PropertySets *.§§§|*.§§§|Alle Dateien *.*|*.*"
    .Flags = cdlOFNHideReadOnly Or cdlOFNPathMustExist _
     Or cdlOFNOverwritePrompt
    On Error Resume Next
    .ShowSave
    If Err.Number = 0 Then
      Set nBag = New PropertyBag
      UserControl_WriteProperties nBag
      nBag.WriteProperty "PBSet", "123Control"
      nVar = nBag.Contents
      On Error Resume Next
      Kill .FileName
      On Error GoTo 0
      nFNr = FreeFile
      Open .FileName For Binary Access Write Lock Write As #nFNr
        Put #nFNr, , nVar
      Close #nFNr
    End If
  End With
  PropertyChanged "SaveSets"
End Property

Public Property Get LoadSets() As Boolean
  '
End Property

Public Property Let LoadSets(New_Load As Boolean)
  Dim nBag As PropertyBag
  Dim nFNr As Integer
  Dim nVar As Variant
  
  With CommonDialog1
    .CancelError = True
    .DialogTitle = "Vorlagen-Sets laden"
    .DefaultExt = "§§§"
    .Filter = "PropertySets *.§§§|*.§§§|Alle Dateien *.*|*.*"
    .Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly _
     Or cdlOFNPathMustExist
    On Error Resume Next
    .ShowOpen
    If Err.Number = 0 Then
      nFNr = FreeFile
      Open .FileName For Binary Access Read Lock Read As #nFNr
        Get #nFNr, , nVar
      Close #nFNr
      Set nBag = New PropertyBag
      nBag.Contents = nVar
      If nBag.ReadProperty("PBSet") = "123Control" Then
        UserControl_ReadProperties nBag
      Else
        MsgBox "Ungültiges Format!"
      End If
    End If
  End With
  PropertyChanged "LoadSets"
End Property

Das kleine i-Tüpfelchen wird nun noch von der Möglichkeit aufgesetzt, die Set-Sammlung in die Zwischenablage zu kopieren und von dort aus in eine andere Instanz des gleichen UserControls einzufügen. Auch hier fügen Sie wieder die Kennung des Steuerelement-Typs hinzu. Den Byte-Array-Inhalt des Sammel-PropertyBag-Objekts weisen Sie nun einem String zu bzw. weisen den aus der Zwischenablage kommenden String über eine Zwischenstation als Byte-Array wieder einem PropertyBag-Objekt zu. Damit der Weg über den String funktioniert, ist zusätzlich seine Konvertierung ins Unicode-Format und wieder zurück notwendig. Und da der Unicode-String Nullzeichen enthält, die die Zwischenablage in C-Manier zum Kappen des Strings veranlassen, tauschen Sie die Nullzeichen zuvor noch gegen eine "unmögliche" Zeichenfolge aus und restaurieren die Nullzeichen hinterher wieder (siehe auch "Zwischenablagen-Esperanto").

Public Property Get Copy() As Boolean
  '
End Property

Public Property Let Copy(New_Copy As Boolean)
  Dim nBag As PropertyBag
  Dim nString As String
  Dim nBytes() As Byte
  
  Set nBag = New PropertyBag
  UserControl_WriteProperties nBag
  nBag.WriteProperty "PBSet", "123Control"
  nBytes = nBag.Contents
  nString = nBytes
  nString = StrConv(nString, vbUnicode)
  nString = Replace(nString, vbNullChar, "§%§%§%§%§%§%§%§%")
  With Clipboard
    .Clear
    .SetText nString, vbCFText
  End With
  PropertyChanged "Copy"
End Property

Public Property Get Paste() As Boolean
  '
End Property

Public Property Let Paste(New_Paste As Boolean)
  Dim nBag As PropertyBag
  Dim nString As String
  Dim nBytes() As Byte
  Dim nVar As Variant
  
  nString = Clipboard.GetText(vbCFText)
  nString = Replace(nString, "§%§%§%§%§%§%§%§%", vbNullChar)
  nString = StrConv(nString, vbFromUnicode)
  nBytes = nString
  nVar = nBytes
  Set nBag = New PropertyBag
  On Error Resume Next
  If Err.Number = 0 Then
    nBag.Contents = nBytes
    If nBag.ReadProperty("PBSet") = "123Control" Then
      UserControl_ReadProperties nBag
    Else
      MsgBox "Ungültiges Format!"
    End If
    UserControl_ReadProperties nBag
  End If
  PropertyChanged "PasteAll"
End Property

Im Beispiel-Projekt, das Sie zu diesem Artikel herunterladen können, habe ich übrigens die Namen der einzelnen Prozeduren mit einem Präfix versehen, damit die Prozeduren im Eigenschaften-Fenster praktischerweise schön beieinander stehen, und das Präfix darüber hinaus auch gleich noch um einen Buchstaben zur Sortierung ergänzt.

Natürlich können Sie die gesamte Funktionalität auch zur Laufzeit nutzen. Verändern Sie beispielsweise eine Bildeigenschaft je Set, können Sie die Sets der Reihe nach aufrufen und so eine Animation erstellen.

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