Attribute VB_Name = "cast_techName"
'-------------------------------------------------------------------------------
'File         : cast_techName.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/techName
'Environment  : VBA 2007 +
'Version      : 2.1.0
'Name         : techName
'Author       : Stefan Erb (ERS)
'History      : 05.05.2014 - ERS - Creation
'               28.05.2014 - ERS - tnStrConv hinzugefügt um die unnützen Einträge aus VbStrConv rauszufiltern
'               11.06.2014 - ERS - Trim erweitert, damit er auch mit Zahlen richtig funktioniert
'               31.10.2014 - ERS - Cache durch Static ersetzt
'               20.11.2015 - ERS - Delemiter als neuer Paramter hinzugefügt, eineige überarbeitet
'               03.01.2017 - ERS - Korrektuf für vbPropertCase
'-------------------------------------------------------------------------------
Option Explicit

'Auswahl der elraubten StrConv
Public Enum tnStrConv
    vbUpperCase = VbStrConv.vbUpperCase
    vbLowerCase = VbStrConv.vbLowerCase
    vbProperCase = VbStrConv.vbProperCase
End Enum

'/**
' * Erstellt aus einem String einen technischen Namen
' * @param  String      Name der gewandelt werden soll
' * @param  Integer     Maximale Länge
' * @param  tnStrConv   Art der Konvertierung. Lower/Uper/Proper-Case
' * @param  String      Deleimter. Default: Bei Proper Case '' ansonsten '_'
' * @return String
' */
Public Function techName( _
        ByVal iName As String, _
        Optional ByVal iMaxLen As Integer = 255, _
        Optional ByVal iStrConv As tnStrConv = vbUpperCase, _
        Optional ByVal iDelemiter As Variant = Null _
) As String
    Static rxNonWords  As Object:   If rxNonWords Is Nothing Then Set rxNonWords = cRx("/([\W_]+)/g")
    Static rxTrim As Object:        If rxTrim Is Nothing Then Set rxTrim = cRx("/(^[\W_]+|[\W_]+$)/g")
    Dim delimiter As String:        delimiter = NZ(iDelemiter, IIf(iStrConv = vbProperCase, "", "_"))
    
    techName = LCase(iName)
    
    'Umlaute entfernen
    Dim k As Variant: For Each k In dictUmlaute.keys
        techName = replace(techName, k, dictUmlaute.item(k))
    Next k

    'Für den strConv die Nicht-Wörter durch " " ersetzen
    techName = rxNonWords.replace(techName, " ")

    'String Convertierung
    techName = StrConv(techName, iStrConv)
    
    'Alle Nicht-Buchstaben durch _ oder '' ersezuen
    techName = rxNonWords.replace(techName, delimiter)
    'Führende und folgende Delemiter entfernen
    techName = rxTrim.replace(techName, "")
    
    'ggf Länge reduzieren
    techName = Left(techName, iMaxLen)

End Function

'Cachehandling

Private Property Get dictUmlaute() As Object
    Static cacheDictUmlaute As Object:
    If cacheDictUmlaute Is Nothing Then
        Set cacheDictUmlaute = CreateObject("scripting.Dictionary")
        With cacheDictUmlaute
            'Hier weitere Umsetzungen programmieren. Alle in LowerCase. Umlaut:Übersetzung
            .add "ä", "ae": .add "ö", "oe": .add "ü", "ue": .add "ß", "ss": .add "é", "e": .add "è", "e"
        End With
    End If
    Set dictUmlaute = cacheDictUmlaute
End Property

'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.Execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function