|
In vielen Anwendungen, die in ihrer Benutzeroberfläche dem
Anwender die Möglichkeit zur Laufwerksauswahl bieten, finden Sie
Toolbars mit den Symbolen der aktuell verfügbaren Laufwerke.
Auf der Basis eines UserControls können Sie eine solche
Laufwerks-ToolBar mit einfachen Mitteln erstellen. Sie benötigen
dazu die Toolbar und die ImageListe aus den Microsoft Common
Controls (Version 6) und das FileSystemObject aus der
Scripting-Komponente. Das FileSystemObject bietet einen problemlosen
Zugriff auf die aktuelle Laufwerksliste und darüber hinaus liefert
zu jedem einzelnen Laufwerk eine ganze Reihe interessanter
Informationen. Sie könnten diese Funktionalität des
FileSystemObjects zwar auch selbst programmieren. Da die Visual
Basic-eigenen Mittel dazu nicht umfangreich genug sind, müssten Sie
allerdings auf eine ganze Reihe von API-Funktionen ausweichen, um
den gleichen Funktionsumfang bieten zu können. Dieser Weg mag zwar
zu einem Quäntchen mehr an Performance führen, doch ist dies bei
einem Benutzeroberflächen-Element dieser Art sicher nicht so
relevant. Ihr Steuerelement wäre dann zwar auch von der
Scripting-Komponente unabhängig, die ab Visual Basic 6
jedoch standardmäßig zur Verfügung steht und Sie somit keine
Abhängigkeit vom Internet Explorer zu befürchten haben.
Die Hauptaufgabe besteht darin, zu jedem der aktuell zur
Verfügung stehenden Laufwerke einen Button in die Toolbar
einzufügen. Dies sollte in jedem Betriebszustand des UserControls
erfolgen - beim erstmaligen Einfügen in einen Container (Form
usw.), zur Designzeit und selbstverständlich zur Laufzeit. Daher
verlegen Sie diese Aufgabe am besten in eine eigene private
Prozedur, die sowohl vom InitProperties- als auch vom
ReadProperties-Ereignis des UserControls aus aufgerufen wird. Mit
dem Aufruf wird das
als Voreinstellung zu setzende Laufwerk übergeben: Im
InitProperties-Ereignis wird das aktuelle Laufwerk über die
VB-Funktion CurDir ermittelt und übergeben, im
ReadProperties-Ereignis ist es das gespeicherte Laufwerk. Zu Beginn
der Prozedur wird der als StartDriveLetter übergebene Wert auf das
erste Zeichen gekürzt. Falls unvorhergesehenerweise ein leerer
String übergeben wurde, wird auch hier ersatzweise über CurDir das
aktuelle Laufwerk ermittelt und gesetzt.
Private Sub zInit(StartDriveLetter As String)
Dim nFSO As New FileSystemObject
Dim nDrive As Drive
Dim nButton As Button
Dim nStartDriveLetter As String
If Trim(StartDriveLetter) = "" Then
nStartDriveLetter = Left$(CurDir, 1)
Else
nStartDriveLetter = Left$(StartDriveLetter, 1)
End If
Anschließend wird die Drives-Collection des FileSystemObjects
durchlaufen und für jedes Laufwerk ein Button in die Toolbar
eingefügt.
For Each nDrive In nFSO.Drives
With nDrive
Set nButton = tbr.Buttons.Add(, .DriveLetter, _
.DriveLetter & ":", tbrButtonGroup, "d" & .DriveType)
Als Schlüssel (Key) eines jeden Buttons wird der
Laufwerksbuchstabe (Eigenschaft DriveLetter des jeweiligen
Drive-Objekts) verwendet. Als Caption wird ebenfalls der
Laufwerkbuchstabe eingesetzt, erweitert um den Doppelpunkt. Da immer
nur ein Laufwerk gewählt werden sollte, werden die Buttons als
gegenseitig auslösende Gruppe angelegt. Dazu erhält jeder Button
den Style-Wert tbrButtonGroup. Schließlich wird noch das dem
Laufwerkstyp entsprechende Symbol aus der der Toolbar zugeordneten
ImageList zugewiesen. Um den nummerischen Wert des Laufwerkstyps
(Eigenschaft DriveType des Drive-Objekts) ohne Umstände direkt
verwenden zu können, haben die Schlüssel der Symbole in der
ImageList jeweils gleich den entsprechenden Wert als Schlüssel
erhalten (dem allerdings ein Buchstabe vorangestellt sein muss, da
die Common-Controls keine nummerischen Werte als Keys akzeptieren).
Die eins zu eins der Enumeration der Scripting-Komponente
entsprechende exportierte Enumeration sieht so aus:
Public Enum tbdDriveTypeConstants
tbdUnknown
tbdRemovable
tbdFixed
tbdRemote
tbdCDRom
tbdRamDisk
End Enum
Da es wenig Sinn macht, die Buttons zur Designzeit mit
Tooltip-Texten zu versehen, erfolgt dies auch nur zur Laufzeit des
UserControls (Ambient.UserMode ist True). Sie können über die
Eigenschaft ToolTipVolumeName festlegen, ob die Tooltips nur die
Laufwerkskennung alleine (Laufwerksbuchstabe mit Doppelpunkt) oder
auch den Datenträgernamen (Eigenschaft VolumeName des
Drive-Objekts) enthalten sollen. Damit aber Laufwerke mit
entfernbaren Datenträgern wie Disketten und CD-ROMs
(oder unwägbare unbekannte Laufwerke) nicht jedes Mal anspringen,
wird bei diesen jedoch nicht versucht, den Laufwerksnamen
auszulesen.
If Ambient.UserMode Then
Select Case .DriveType
Case CDRom, Removable, Unknown
nButton.ToolTipText = .DriveLetter & ":"
Case Else
If pToolTipVolumeName Then
On Error Resume Next
nButton.ToolTipText = .DriveLetter & ": [" & _
.VolumeName & "]"
If Err.Number Then
nButton.ToolTipText = .DriveLetter & ":"
End If
Else
nButton.ToolTipText = .DriveLetter & ":"
End If
End Select
Eine Unsauberkeit der Toolbar bei der Darstellung in einem
Container wie dem UserControl zur Designzeit zwingt uns zu einem
kleinen Kunstgriff. Wie erwähnt wollen wir ja ein Laufwerk als
Voreinstellung setzen, und somit die Value-Eigenschaft des
entsprechenden Buttons auf tbPressed. Würde dies jedoch erfolgen,
solange das UserControl, und damit die Toolbar, noch nicht
vollständig geladen ist (bevor der gesamte Lademechanismus des
äußeren Containers - z.B. ein Form - abgeschlossen ist),
funktioniert die Gruppeneigenschaft nicht richtig: Der
voreingestellte Button bleibt immer gedrückt, auch wenn später zur
Designzeit ein anderes Laufwerk eingestellt und damit ein anderer
Button als gedrückt gewählt wird. Zur Laufzeit tritt diese
Unsauberkeit jedoch nicht auf, so dass wir bereits beim Einlesen der
Laufwerke (und eben hier noch im Zweig des Laufzeit-Modus) den
Laufwerksbuchstaben des Drive-Objekts mit der der Prozedur
übergeben Voreinstellung vergleichen und gegebenenfalls die
Value-Eigenschaft des Buttons setzen können.
If .DriveLetter = nStartDriveLetter Then
nButton.Value = tbrPressed
End If
End If
End With
Next 'i
Zur Designzeit hingegen verwenden wir dagegen einen Timer, dessen
Tag-Eigenschaft der voreingestellte Laufwerksbuchstabe übergeben
und der sogleich gestartet wird (Enabled gleich True).
With tmr
.Tag = nStartDriveLetter
.Enabled = True
End With
UserControl_Resize
End Sub
Der Trick dabei ist, dass der Timer eben auch erst dann zum Zuge
kommt, wenn der gesamte Ladevorgang abgeschlossen ist. Er
deaktiviert sich dann sofort wieder und liest in unsere eigene
Eigenschaft Drive (die sich um das Weitere kümmert) den im Tag
übergebenen Laufwerksbuchstaben ein:
Private Sub tmr_Timer()
With tmr
.Enabled = False
Me.Drive = .Tag
End With
End Sub
Neben dieser Startprozedur bildet die Drive-Eigenschaft das
zweite Herzstück unserer Laufwerks-Toolbar. Betrachten wir
zunächst den Get-Teil der Eigenschaft. Da die Toolbar uns leider
keine Information darüber liefern kann, welcher Button einer Gruppe
gewählt ist, müssen wir die Button-Sammlung durchlaufen, um den
aktuell gewählten Button ausfindig zu machen. Maximal wären 26
Buttons zu prüfen. Doch sind es in der Regel weniger, und
außerdem geht das so schnell, dass niemand etwas bemerken wird.
Natürlich könnten Sie das aktuell gewählte Laufwerk auch in einer
modulweiten Variablen festhalten. Doch damit handeln Sie sich nur
zusätzliche Arbeit und möglicherweise Fehlerquellen ein. Sie
brauchen sich lediglich zu merken, dass ein leerer String
zurückgegeben wird, wenn aus irgendeinem Grund kein Button, und
somit kein Laufwerk, gewählt ist.
Public Property Get Drive() As String
Dim nButton As Button
For Each nButton In tbr.Buttons
If nButton.Value = tbrPressed Then
Drive = nButton.Caption
Exit For
End If
Next
End Property
Der Let-Teil ist ein wenig aufwändiger. Praktischerweise sollte
man der Eigenschaft nicht nur einen einzelnen Laufwerksbuchstaben,
sondern auch ganze Pfadangaben übergeben können. Denn letztlich
müssen Sie den übergebenen String sowieso prüfen und zur
Verwendung als Schlüssel für den Zugriff auf einen Button auf den
ersten Buchstaben kürzen.
Public Property Let Drive(New_Drive As String)
Dim nDriveLetter As String
Dim nButton As Button
nDriveLetter = Trim$(UCase$(Left$(New_Drive, 1)))
Bleibt nach dieser Prüfung und Trimmung von Leerzeichen nur ein
leerer String übrig, gehen wir davon aus, dass das aktuelle
Laufwerk gewählt werden soll. In diesem Fall setzen wir die
Eigenschaft Drive einfach in einem rekursiven Aufruf auf den Wert
von CurDir.
Select Case nDriveLetter
Case ""
Me.Drive = CurDir
Case "A" To "Z"
Haben wir es mit einem im Prinzip gültigen Laufwerksbuchstaben
zu tun, also einem Buchstaben von A bis Z,
und unterscheidet sich dieser von der aktuellen Auswahl (diese
erfahren wir über den Get-Teil der Eigenschaft), setzen wir den
Wert des entsprechenden Buttons auf tbrPressed. Aufgrund der
Style-Einstellung tbrButtonGroup der Buttons wird der zuvor
gewählte Button automatisch auf tbrUnpressed gesetzt - es kann ja
nur einer gewählt sein - und wir haben keine weitere Arbeit damit.
In dem Fall, dass das Laufwerk, und damit der zugehörige Button
nicht mehr existieren sollte, wird der Laufzeitfehler Nr. 380
ausgelöst. Er besagt, dass versucht wurde, der Eigenschaft einen
ungültigen Wert zuzuweisen.
If Left$(Me.Drive, 1) <> nDriveLetter Then
On Error Resume Next
tbr.Buttons(nDriveLetter).Value = tbrPressed
If Err.Number Then
Err.Raise 380
End If
Natürlich erwartet die "Außenwelt", von der Änderung
der Auswahl informiert zu werden. Dies erfolgt über das
selbstdefinierte Ereignis Change:
Public Event Change(Drive As String)
das wir hier nun auslösen. Praktischerweise transportiert es
gleich auch die neue aktuelle Auswahl als Parameter.
RaiseEvent Change(nDriveLetter & ":")
End If
Wurde als Wert für die Eigenschaft irgendwelcher sonstiger
"Müll" übergeben, wird ebenfalls der erwähnte
Laufzeitfehler ausgelöst.
Case Else
Err.Raise 380
End Select
PropertyChanged "Drive"
End Property
Die Wahl des Anwenders durch einen Klick auf einen der
Laufwerk-Buttons wird im ButtonClick-Ereignis der Toolbar direkt und
ohne viel Federlesens über das Change-Ereignis nach draußen
gemeldet:
Private Sub tbr_ButtonClick(ByVal Button As MSComctlLib.Button)
RaiseEvent Change(Button.Caption)
End Sub
Da wir gerade bei Ereignissen sind: Eigentlich braucht unsere
Laufwerks-Toolbar keine weiteren Ereignisse, um ihren Zweck zu
erfüllen. Doch da Sie vielleicht einem Laufwerks-Symbol ein
Kontextmenü (Popup-Menü) zuordnen möchten, sollte zumindest ein
Klick mit der rechten Maustaste auf einen der Buttons gemeldet
werden. Anders als etwa das TreeView- oder das
ListView-Steuerelement aus den Common-Controls lässt die Toolbar
leider ein Prüfmöglichkeit wie HitTest missen. Wir müssen also im
MouseUp-Ereignis (Windows-Standard, wann Kontextmenüs angezeigt
werden sollen) selbst prüfen, ob sich ein Button, und wenn ja,
welcher sich unter dem Mauszeiger befindet. Glücklicherweise
verfügt ein Button dazu über die Eigenschaften Left, Top, Width
und Height. Im Trefferfalle lösen wir das Ereignis ButtonRightClick
aus:
Public Event ButtonRightClick(Drive As String)
dem wir den Wert der Caption-Eigenschaft des betreffenden Buttons
(Laufwerksbuchstabe plus Doppelpunkt) als Parameter übergeben.
Private Sub tbr_MouseUp(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim nButton As Button
If Button = vbRightButton Then
For Each nButton In tbr.Buttons
With nButton
Select Case x
Case .Left To .Left + .Width
Select Case y
Case .Top To .Top + .Height
RaiseEvent ButtonRightClick(nButton.Caption)
Exit For
End Select
End Select
End With
Next
End If
End Sub
Zur Aktualisierung der angezeigten Laufwerks-Symbole verleihen
wir unserer Laufwerks-Toolbar die Methode Refresh. Sie löscht die
vorhandenen Buttons und ruft einfach die eingangs beschriebene
private Intialisierungs-Prozedur zInit auf, der als Parameter die
aktuelle Laufwerkswahl übergeben wird.
Public Sub Refresh()
tbr.Buttons.Clear
zInit Me.Drive
End Sub
Nun sollte eine Toolbar selbstverständlich an den Rändern ihres
Containers angedockt werden können - also über die
Align-Eigenschaft verfügen. Dazu setzen Sie im
Eigenschaften-Fenster die Alignable-Eigenschaft des UserControls auf
True. Die Align-Eigenschaft des Toolbar-Steuerelements selbst wird
fest auf vbAlignTop gesetzt. Die Toolbar innerhalb des UserControls
entsprechend der Align-Einstellung des UserControls (genau genommen
von dessen Extender-Objekt) in diesem herum zu bugsieren, bringt
nämlich nichts (wie einige Versuche gezeigt haben.
Da es außerdem sinnvoll ist, dass der Verwender unserer
Laufwerks-Toolbar festlegen könne soll, ob eine horizontale Toolbar
in jedem Fall einzeilig sein soll, oder bei zu vielen Laufwerken
umbrochen werden soll, wird wie bei der originalen Toolbar die
Eigenschaft Wrappable geboten.
Public Property Get Wrappable() As Boolean
Wrappable = pWrappable
End Property
Public Property Let Wrappable(ByVal New_Wrappable As Boolean)
If pWrappable <> New_Wrappable Then
pWrappable = New_Wrappable
UserControl_Resize
End If
PropertyChanged "Wrappable"
End Property
Wird der Wert der Eigenschaft geändert, wird zur Aktualisierung
der Darstellung die Ereignis-Prozedur des Resize-Ereignisses des
UserControls aufgerufen.
Allerdings kann der Wert der Wrappable-Eigenschaft nicht immer
eins zu eins an die originale Toolbar durchgereicht werden, sondern
nur dann, wenn die Align-Eigenschaft des UserControls auf horizontal
gesetzt ist (vbAlignTop oder vbAlignBottom). Bei vertikaler
Ausrichtung des UserControls (vbAlignLeft oder vbAlignRight) muss
die Toolbar auf jeden Fall umbrochen werden, damit die Buttons
untereinander erscheinen (Eigenschaft Wrappable gleich True). Den
Umbruch erzwingen wir, indem wir im UserControl-Resize-Ereignis die
weiterhin oben horizontal ausgerichtete originale Toolbar auf die
Breite eines Buttons zwingen, indem wir das UserControl auf die
entsprechende Breite setzen.
Bei einer horizontalen Ausrichtung des UserControls übernehmen
die den Wert unserer Wrappable-Eigenschaft in die Toolbar und sorgen
dafür, dass sich das UserControl in der Höhe der Toolbar anpasst.
Da eine Änderung der Größe des UserControls das
Resize-Ereignis erneut auslösen würde, während es noch gar nicht
vollständig abgearbeitet ist, sperren wir den erneuten
vollständigen Durchlauf mittels der statischen Booleschen Variablen
sInProc (siehe  "Aller
guten Dinge ist eins").
Private Sub UserControl_Resize()
Static sInProc As Boolean
If sInProc Then
Exit Sub
Else
sInProc = True
End If
With tbr
Select Case Extender.Align
Case vbAlignLeft, vbAlignRight
.Wrappable = True
UserControl.Width = .Buttons(1).Width + _
2 * Screen.TwipsPerPixelX
Case vbAlignNone, vbAlignTop, vbAlignBottom
.Wrappable = pWrappable
UserControl.Height = .Height
End Select
End With
sInProc = False
End Sub
Damit hätten wir die eigentliche Funktionalität der
Laufwerks-Toolbar fertiggestellt. Das weitere ist nun lediglich ein
wenig Komfortarbeit.
Zunächst bieten wir eine Appearance-Eigenschaft für eine flache
oder erhabene Darstellung unserer Toolbar. Zum einen setzen wir die
Appearance-Eigenschaft der originalen Toolbar direkt entsprechend
dem gewünschten Wert (bzw. lesen diesen im Get-Teil aus). Wir
müssen aber zugleich noch die BorderStyle-Eigenschaft mit setzen,
damit die gewünschte Darstellung erscheint.
Public Enum tbdAppearanceConstants
tbdFlat
tbd3D
End Enum
Public Property Get Appearance() As tbdAppearanceConstants
Appearance = tbr.Appearance
End Property
Public Property Let Appearance(ByVal New_Appearance _
As tbdAppearanceConstants)
With tbr
.Appearance = New_Appearance
.BorderStyle = New_Appearance
End With
PropertyChanged "Appearance"
End Property
Nun bleibt nur noch übrig, die vielen Informationen, die das
Drive-Objekt der Scriptig-Komponente über ein Laufwerk zu bieten
hat, als Eigenschaften der Laufwerks-Toolbar offen zu legen.
Man könnte sich nun darüber streiten, ob dies tatsächlich
über Eigenschaften erfolgen soll, oder über Funktionen. Im Prinzip
läuft das auf dasselbe hinaus - in jedem Fall ist als Parameter der
gewünschte Laufwerksbuchstabe anzugeben, wenn nicht das aktuell
gewählte Laufwerk gemeint sein soll. Da aber der Regelfall eben die
Abfrage von Informationen über das aktuell gewählte Laufwerk sein
dürfte, erscheint die Implementierung als Eigenschaften ein wenig
naheliegender.
Betrachten wir die in der alphabetischen Reihenfolge erste
Eigenschaft AvailableSpace näher - die übrigen Eigenschaften
funktionieren nach exakt dem gleichen Muster.
Zunächst legen wir eine private Funktion an, die die Prüfung
des übergebenen Laufwerks-String vornimmt. Ergibt sich, dass ein
leerer String übergeben wurde, wird über unsere eigene Eigenschaft
Drive das aktuelle Laufwerk abgefragt.
Private Function zCheckDriveLetter(DriveLetter As String) _
As String
Dim nDriveLetter As String
nDriveLetter = Trim$(UCase$(Left$(DriveLetter, 1)))
If Len(nDriveLetter) = 0 Then
zCheckDriveLetter = Left$(Me.Drive, 1)
Else
zCheckDriveLetter = nDriveLetter
End If
End Function
Den Rückgabewert dieser Funktion setzen wir als Schlüssel ein,
um ein Drive-Objekt aus der Drives-Sammlung des FileSystemObjects zu
bestimmen. Letzteres brauchen wir noch nicht einmal zu deklarieren,
sondern können es direkt als Argument eines With-Blocks
instanzieren. Das Ergebnis der Abfrage der betreffenden Eigenschaft
des Drive-Objekts geben wir als Wert der Property Get-Prozedur
zurück.
Public Property Get AvailableSpace _
(Optional DriveLetter As String) As Variant
With New FileSystemObject
AvailableSpace = _
.Drives(zCheckDriveLetter(DriveLetter)).AvailableSpace
End With
End Property
Die Namen der einzelnen Eigenschaften sprechen für sich - und
entsprechen direkt den Eigenschaft des Drive-Objekts:
Public Property Get DriveType _
(Optional DriveLetter As String) As tbdDriveTypeConstants
With New FileSystemObject
DriveType = .Drives(zCheckDriveLetter(DriveLetter)).DriveType
End With
End Property
Public Property Get FreeSpace(Optional DriveLetter As String) _
As Variant
With New FileSystemObject
FreeSpace = .Drives(zCheckDriveLetter(DriveLetter)).FreeSpace
End With
End Property
Public Property Get FileSystem(Optional DriveLetter As String) _
As String
With New FileSystemObject
FileSystem = .Drives(zCheckDriveLetter(DriveLetter)).FileSystem
End With
End Property
Public Property Get IsReady(Optional DriveLetter As String) _
As Boolean
With New FileSystemObject
IsReady = .Drives(zCheckDriveLetter(DriveLetter)).IsReady
End With
End Property
Public Property Get SerialNumber(Optional DriveLetter As String) _
As Long
With New FileSystemObject
SerialNumber = _
.Drives(zCheckDriveLetter(DriveLetter)).SerialNumber
End With
End Property
Public Property Get ShareName(Optional DriveLetter As String) _
As String
With New FileSystemObject
ShareName = .Drives(zCheckDriveLetter(DriveLetter)).ShareName
End With
End Property
Public Property Get TotalSize(Optional DriveLetter As String) _
As Variant
With New FileSystemObject
TotalSize = .Drives(zCheckDriveLetter(DriveLetter)).TotalSize
End With
End Property
Public Property Get VolumeName(Optional DriveLetter As String) _
As String
With New FileSystemObject
VolumeName = _
.Drives(zCheckDriveLetter(DriveLetter)).VolumeName
End With
End Property
Zu guter Letzt bleibt nun noch ein wenig Verwaltungskram übrig,
über den ich wohl keine weiteren Worte zu verlieren brauche.
Private Sub UserControl_Initialize()
pToolTipVolumeName = True
pWrappable = True
End Sub
Private Sub UserControl_InitProperties()
zInit CurDir
On Error Resume Next
Extender.TabStop = False
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Me.Appearance = PropBag.ReadProperty("Appearance", tbdFlat)
pToolTipVolumeName = PropBag.ReadProperty("ToolTipVolumeName", _
True)
pWrappable = PropBag.ReadProperty("Wrappable", True)
zInit PropBag.ReadProperty("Drive", "C:")
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "Appearance", tbr.Appearance, tbdFlat
PropBag.WriteProperty "Drive", Me.Drive, "C:"
PropBag.WriteProperty "ToolTipVolumeName", pToolTipVolumeName, _
True
PropBag.WriteProperty "Wrappable", pWrappable, True
End Sub
|