Attribute VB_Name = "basTurkishCasing"
Option Compare Binary
Option Explicit

Private Const LCMAP_BYTEREV = &H800 ' byte reversal
Private Const LCMAP_LOWERCASE = &H100   ' lower case letters
Private Const LCMAP_SORTKEY = &H400 ' WC sort key (normalize)
Private Const LCMAP_UPPERCASE = &H200   ' upper case letters
Private Const LCMAP_HALFWIDTH = &H800   ' map double byte to single byte
Private Const LCMAP_FULLWIDTH = &H1000  ' map single byte to double byte
Private Const LCMAP_HIRAGANA = &H2000   ' map katakana to hiragana
Private Const LCMAP_KATAKANA = &H4000   ' map hiragana to katakana
Private Const LCMAP_LINGUISTIC_CASING = &H1000000     ' use linguistic rules for casing
Private Const LCMAP_SIMPLIFIED_CHINESE = &H2000000   ' map traditional chinese to simplified chinese
Private Const LCMAP_TRADITIONAL_CHINESE = &H4000000  ' map simplified chinese to traditional chinese

Private Const NORM_IGNORECASE = &H1 ' ignore case
Private Const NORM_IGNORENONSPACE = &H2 ' ignore nonspacing chars
Private Const NORM_IGNORESYMBOLS = &H4  ' ignore symbols
Private Const NORM_IGNOREWIDTH = &H8    '  ignore width
Private Const NORM_IGNOREKANATYPE = &H40    ' ignore kanatype

Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function LCMapStringA Lib "kernel32" _
 (ByVal Locale As Long, ByVal dwMapFlags As Long, _
 ByVal lpSrcStr As Long, ByVal cchSrc As Long, _
 ByVal lpDestStr As Long, ByVal cchDest As Long) As Long
Private Declare Function LCMapStringW Lib "kernel32" _
 (ByVal Locale As Long, ByVal dwMapFlags As Long, _
 ByVal lpSrcStr As Long, ByVal cchSrc As Long, _
 ByVal lpDestStr As Long, ByVal cchDest As Long) As Long

' These two functions give you an international version of
' UCase and LCase that will change as needed depending
' on LCID (when you use Turkish by passing 1055, for
' example).
Public Function UCaseIntl(stIn As String, Optional LCID As Long = 1024) As String
    Dim cch As Long
    Dim lpDestStr As String
    Dim lpSrcStrAnsi As String
    
    If FOnWindowsNT Then
        cch = LCMapStringW(LCID, LCMAP_UPPERCASE Or LCMAP_LINGUISTIC_CASING, _
         StrPtr(stIn), -1, StrPtr(vbNullString), 0&)
        If cch > 0 Then
            lpDestStr = String$(cch, vbNullChar)
            cch = LCMapStringW(LCID, LCMAP_UPPERCASE Or LCMAP_LINGUISTIC_CASING, _
             StrPtr(stIn), -1, StrPtr(lpDestStr), Len(lpDestStr))
        End If
    Else
        lpSrcStrAnsi = StrConv(stIn, vbFromUnicode, LCID)
        cch = LCMapStringA(LCID, LCMAP_UPPERCASE Or LCMAP_LINGUISTIC_CASING, _
         StrPtr(lpSrcStrAnsi), -1, StrPtr(vbNullString), 0&)
        If cch > 0 Then
            lpDestStr = String$(cch, vbNullChar)
            cch = LCMapStringA(LCID, LCMAP_UPPERCASE Or LCMAP_LINGUISTIC_CASING, _
             StrPtr(lpSrcStrAnsi), -1, StrPtr(lpDestStr), Len(lpDestStr))
            lpDestStr = StrConv(lpDestStr, vbUnicode, LCID)
        End If
    End If
    
    If cch > 0 Then UCaseIntl = Left$(lpDestStr, cch - 1)
End Function
Public Function LCaseIntl(stIn As String, Optional LCID As Long = 1024) As String
    Dim cch As Long
    Dim lpDestStr As String
    Dim lpSrcStrAnsi As String
    
    If FOnWindowsNT Then
        cch = LCMapStringW(LCID, LCMAP_LOWERCASE Or LCMAP_LINGUISTIC_CASING, _
         StrPtr(stIn), -1, StrPtr(vbNullString), 0&)
        If cch > 0 Then
            lpDestStr = String$(cch, vbNullChar)
            cch = LCMapStringW(LCID, LCMAP_LOWERCASE Or LCMAP_LINGUISTIC_CASING, _
             StrPtr(stIn), -1, StrPtr(lpDestStr), Len(lpDestStr))
        End If
    Else
        lpSrcStrAnsi = StrConv(stIn, vbFromUnicode, LCID)
        cch = LCMapStringA(LCID, LCMAP_LOWERCASE Or LCMAP_LINGUISTIC_CASING, _
         StrPtr(lpSrcStrAnsi), -1, StrPtr(vbNullString), 0&)
        If cch > 0 Then
            lpDestStr = String$(cch, vbNullChar)
            cch = LCMapStringA(LCID, LCMAP_LOWERCASE Or LCMAP_LINGUISTIC_CASING, _
             StrPtr(lpSrcStrAnsi), -1, StrPtr(lpDestStr), Len(lpDestStr))
            lpDestStr = StrConv(lpDestStr, vbUnicode, LCID)
        End If
    End If
    
    If cch > 0 Then LCaseIntl = Left$(lpDestStr, cch - 1)
End Function

' These versions of UCase and LCase give you the Turkish
' casing rules, and should only be used when you want the
' Turkish casing rules to apply. Note that you can also use
' the LCMapString API with the appropriate flag (which
' would be LCMAP_LINGUISTIC_CASING).
Function UCase(vIn)
    If IsNull(vIn) Then
        UCase = Null
    Else
        Select Case AscW(vIn)
            Case 305    ' Dotless lowercase I
                ' Convert to dotless uppercase I
                UCase = ChrW$(73)
            Case 105    ' Dotted lowercase I
                ' Convert to dotted uppercase I
                UCase = ChrW$(304)
            Case Else
                UCase = VBA.UCase$(vIn)
        End Select
    End If
End Function

Function LCase(vIn)
    If IsNull(vIn) Then
        LCase = Null
    Else
        Select Case AscW(vIn)
            Case 73    ' Dotless uppercase I
                ' Convert to dotless lowercase I
                LCase = ChrW$(305)
            Case 304    ' Dotted uppercase I
                ' Convert to dotted lowercase I
                LCase = ChrW$(105)
            Case Else
                LCase = VBA.LCase$(vIn)
        End Select
    End If
End Function


' Support functions
Private Property Get FOnWindowsNT() As Boolean
    FOnWindowsNT = (HiByte(LoWord(GetVersion)) = 0)
End Property

Public Function HiByte(ByVal iWord As Integer) As Byte
    HiByte = (iWord And &HFF00) \ (2 ^ 8)
End Function
Public Function LoByte(ByVal iWord As Integer) As Byte
    LoByte = iWord And &HFF
End Function
Public Function HiWord(ByVal lDWord As Long) As Integer
    HiWord = (lDWord And &HFFFF0000) \ (2 ^ 16)
End Function
Public Function LoWord(ByVal lDWord As Long) As Integer
    LoWord = lDWord And &HFFFF&
End Function