Mit dieser Funktion lässt sich eine Pfadangabe auf eine bestimmte max. Länge kürzen, wobei man auf die gekürzte Anzeige selbst Einfluß nehmen kann. Public Function PfadKurz(ByVal sPath As String, _ ByVal Max_Len As Integer, _ Optional Is_File As Boolean = False, _ Optional ANZ_VR As Integer = 2) As String ' Pfad auf gewünschte Länge bringen, falls notwendig ' bzw. sinnvoll ' ' Verzeichnis-Pfade können mit und ohne "\" am Ende ' eingegeben werden. ' Die Ausgabe ist dann entsprechend mit bzw. ohne ' "\" am Ende. ' ' Die Funktion legt den linken und rechten Anteil der ' Pfadangabe jeweils mit der gewünschten max. Länge in 2 ' ("benachbarte") Spalten eines Datenfeldes und sucht dann ' rein bildlich gesehen den richtigen Platz (Zeilen), die ' mit den 3 Punkten zu versehen sind. ' ' (Nach Regeln: Wieviele Verzeichnisse bzw. "\" sollen von ' rechts übernommen werden usw.) ' ' PARAMETER: ' ' sPath zu kürzender Pfad-String ' ' Max_Len maximale Anzahl Ausgabe-Zeichen ' ' Is_File True, falls es sich bei "sPath" um ' Pfad+Dateiname handelt ' False, falls es sich bei "sPath" um eine ' reine Verzeichnis-Angabe handelt ' ' ANZ_VR Anzahl Verzeichnisangabnen, die auf der rechten ' Seite möglichst vollständig angezeigt werden sollen ' ' -> Mein Geschmack geht dahin: ' Verzeichnis-Pfade: 2 (Verzeichnisse rechts anzeigen) ' Datei-Pfade: 1 (Verzeichnis rechts anzeigen) '------------------------------------------------------------------- Dim i As Integer ' Zähler Dim L As Integer ' letzte von LINKS bereits erledigte Zeichen-Position Dim R As Integer ' letzte von RECHTS bereits erledigte Zeichen-Position Dim z As Integer ' Zähler für Schrägstriche "\" von rechts Dim Strg_Fld() ' Feld mit den Pfad-Zeichen ' Strg_Fld(0, n) 0- Spalte Auszugebener gekürzter Pfad ' Strg_Fld(1, n) 1- Spalte Zeichen linker Anteil ' Strg_Fld(2, n) 2- Spalte Zeichen rechter Anteil Dim X As String ' Ausgabe-String Dim Max_L As Integer ' Maximale Länge intern Dim ANZ_SInt As Integer ' Anzahl Schrägstriche von Rechts PfadKurz = sPath If Len(sPath) = 0 Or Len(sPath) <= Max_Len Then ' keine Überlänge Exit Function End If If Max_Len < 10 Then ' extrem kurz, nur rechten Anteil ausgeben If Max_Len < 3 Then Max_Len = 3 PfadKurz = "..." & Right(sPath, Max_Len - 3) Exit Function End If Max_L = Max_Len ' Maximale Länge intern ANZ_SInt = ANZ_VR + 1 If Is_File = False And Not Right$(sPath, 1) = "\" Then ' Rechts ein \, falls sPath Verzeichnis sein soll sPath = sPath & "\" Max_L = Max_L + 1 ' Maximale Länge intern End If ReDim Strg_Fld(2, Max_L) ' ------------- Feld füllen -------------------------------------- For i = 1 To UBound(Strg_Fld, 2) ' Zeichen linker Anteil Strg_Fld(1, i) = Mid(sPath, i, 1) ' Zeichen rechter Anteil Strg_Fld(2, i) = Mid(sPath, (Len(sPath) + i) - Max_L, 1) Next i ' *** Jetzt muss entschieden werden, wo die 3 Punkte "..." hinkommen *** ' Laufwerk auf jeden Fall If Mid$(sPath, 2, 1) = ":" Then For i = 1 To 3 Strg_Fld(0, i) = Strg_Fld(1, i) ' z.B: "C:\" Next i ' letzte von LINKS bereits erledigte Zeichen-Position L = 3 End If ' Versuch: RECHTS-Verzeichnis(se) unterzubringen mit ' Schrägstrichen "\..\" bzw "\.." z = 0 ' Zähler für Schrägstriche "\" von rechts For i = Max_L To L + 1 Step -1 If z = ANZ_SInt Or i = 6 Then ' ANZ_SInt x "\" rechts reicht aus ' bzw. Zeichen 4,5,6 bleiben (noch) reserviert Exit For End If Strg_Fld(0, i) = Strg_Fld(2, i) ' letzte von RECHTS bereits erledigte Zeichen-Position R = i If Strg_Fld(0, i) = "\" Then z = z + 1 ' Zähler für Schrägstriche "\" von rechts End If Next i ' Versuchen, mit LINKS-Verzeichnis(sen) den restlichen Platz ' in der 0-Spalte aufzufüllen For i = L + 1 To R - 1 ' Nur im noch freien Bereich arbeiten If R - L <= 4 Then Strg_Fld(0, i) = "." Else Strg_Fld(0, i) = Strg_Fld(1, i) End If ' letzte von LINKS bereits erledigte Zeichen-Position L = i Next i ' --- Ausgabe-String aus 0-Spalte entwickeln ------------------- For i = 1 To Max_Len ' Ausgabe für orig. Länge Max_Len ! X = X & Strg_Fld(0, i) Next i PfadKurz = X End Function Aufrufbeispiel: Dim sFile As String sFile = "C:\Dokumente und Einstellungen\All Users\Anwendungsdaten\Excel.xls" Label1.Caption = PfadKurz(sFile, 40, True, 1) Dieser Tipp wurde bereits 15.278 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
Neu! sevCoolbar 3.0 Professionelle Toolbars im modernen Design! Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |