'MacroName:Armenian2Latin
'MacroDescription:Automatically transliterate a field with Armenian characters into Latin characters
'Macro written by: Joel Hahn, Niles Public Library District
'Macro last modified: 22 November 2013

Declare Function TransArmenian(sChar As String, sNextChar As String, nPos As Variant) As String
Declare Function IsArmenChar(sNCR) As Integer

Global arrChars()
Option Explicit


Sub Main
   Dim bool as Integer
   Dim sField As String
   Dim nHasArmen as integer
   Dim NewField As String
   Dim i, a
   Dim sHex As String
   Dim nHex As Long
   Dim TempChar As String
   Dim place3 as Integer
   Dim place As Integer
   Dim sBCR As String

   Dim CS As Object
   On Error Resume Next
   Set CS  = GetObject(,"Connex.Client")
   On Error GoTo 0
   If CS  Is Nothing Then
      Set CS  = CreateObject("Connex.Client")
   End If
   ReDim arrChars(0)

   bool = CS.GetFieldLineUnicode(CS.CursorRow, sField)

   NewField = Left(sField, 5)
   sField = Mid(sField, 6)

   i = 1 : nHasArmen = 0
   Do While i <= Len(sField) - 7
     a = Mid(sField, i, 8)
     If IsArmenChar(Mid(sField, i, 6)) Then
       nHasArmen = 1
       Exit Do
     End If
     i = i + 1
   Loop
   If nHasArmen = 0 Then
      MsgBox "Field contains no Armenian characters. Exiting..."
      Exit Sub
   End If

   'Break up Armenian field in to separate characters
   i = 1
   Do While i <= Len(sField)
      ReDim Preserve arrChars(UBound(arrChars) + 1)
      If Mid(sField, i, 3) = "&#x" Then
         place = InStr(i, sField, ";")
         sBCR = Mid(sField, i, (place - i) + 1)
         arrChars(UBound(arrChars)) = sBCR
         i = place
      Else
         arrChars(UBound(arrChars)) = Mid(sField, i, 1)
      End If
      i = i + 1
   Loop

   i = 1
   Do While i <= UBound(arrChars)
      If InStr(arrChars(i), "&#x") Then
         sHex = Mid(arrChars(i), 4, Len(arrChars(i)) - 2)
         nHex = Val("&H" & sHex)
         Select Case nHex
            Case &H01C2   'Delimiter
               NewField = NewField & Chr(223) 
            Case &H0530 To &H058F   'Armenian character
               If i < UBound(arrChars) Then
                  TempChar = TransArmenian(arrChars(i), arrChars(i+1), i)
                  Dim c
                  If TempChar = "O" And arrChars(i+1) = "&#x0582;" Then
                     TempChar = "U"
                     i = i + 1
                  ElseIf TempChar = "o" And arrChars(i+1) = "&#x0582;" Then
                     TempChar = "u"
                     i = i + 1
                  End If
               Else
                  TempChar = TransArmenian(arrChars(i), "&H0000;", i)
               End If
               NewField = NewField + TempChar
            Case &HFB13 To &HFB17   'Armenian ligature--not valid in Connexion, but might still be present
               TempChar = TransArmenian(arrChars(i), arrChars(i+1), i)
               NewField = NewField + TempChar
            Case Else   'Non-Armenian Unicode character
               NewField = NewField & Chr(252) 
         End Select
      Else
         If arrChars(i) = Chr(171) or arrChars(i) = Chr(187) Then
            'Convert angle-quotation marks; assume plus/minus sign is actually an angle-quotation mark, due to using the same ASCII code point
            NewField = NewField & Chr(34)
         ElseIf arrChars(i) = "~" Then
            NewField = NewField & "!"
         Else
            NewField = NewField & arrChars(i)
         End If
      End If
      i = i + 1
   Loop

   bool = CS.AddFieldLine(CS.CursorRow + 1, NewField)
   CS.CursorRow = CS.CursorRow -1
   CS.SendKeys "%ekl", -1
   
End Sub

'##############################################################################

Function IsArmenChar(sNCR) As Integer
   Dim b
   b = Mid(sNCR, 1, 6)
   If Len(sNCR) = 6 And ((Mid(sNCR, 1, 6) Like "&[#]x05[3-8]") Or (Mid(sNCR, 1, 7) Like "&[#]xFB1")) Then
      IsArmenChar = 1
   Else
      IsArmenChar = 0
   End If
End Function

Function TransArmenian(sChar As String, sNextChar As String, nPos As Variant) As String
   Dim sHex As String
   Dim nHex As Integer
   Dim TempTranslit As String
   Dim sNextHex As String
   Dim nNextHex As Long

   sHex = Mid(sChar, 4, Len(sChar) - 2)
   nHex = Val("&H" & sHex)
   sNextHex = Mid(sNextChar, 4, Len(sNextChar) - 1)
   nNextHex = Val("&H" & sNextHex)

  Select Case nHex
    Case &H0531
      TransArmenian = "A"
    Case &H0532
      TransArmenian = "B"
    Case &H0533
      TransArmenian = "G"
      If nNextHex = &H0540 or nNextHex = &H0570 Then
         TransArmenian = "G" & Chr(167)  'G-prime
      End If
    Case &H0534
      TransArmenian = "D"
      If nNextHex = &H0536 or nNextHex = &H0566 Then
         TransArmenian = "D" & Chr(167)  'D-prime
      End If
    Case &H0535
      TransArmenian = "E"
      If sNextChar = "." Then
         TransArmenian = "Y"
      End If
    Case &H0536
      TransArmenian = "Z"
      If nNextHex = &H0540 or nNextHex = &H0570 Then
         TransArmenian = "Z" & Chr(167)  'Z-prime
      End If
    Case &H0537
      TransArmenian = "E" & Chr(229)  'E-macron
    Case &H0538
      TransArmenian = "E" & Chr(233)  'E-hacek
    Case &H0539
      TransArmenian = "T" & Chr(176)  'T-ayin
    Case &H053A
      TransArmenian = "Zh"
    Case &H053B
      TransArmenian = "I"
    Case &H053C
      TransArmenian = "L"
    Case &H053D
      TransArmenian = "Kh"
    Case &H053E
      TransArmenian = "Ts"
    Case &H053F
      TransArmenian = "K"
    Case &H0540
      TransArmenian = "H"
    Case &H0541
      TransArmenian = "Dz"
    Case &H0542
      TransArmenian = "Gh"
    Case &H0543
      TransArmenian = "Ch"
    Case &H0544
      TransArmenian = "M"
    Case &H0545
      TransArmenian = "Y"
      If sNextChar = "." Then
         TransArmenian = "H"
      End If
    Case &H0546
      TransArmenian = "N"
    Case &H0547
      TransArmenian = "Sh"
    Case &H0548
      TransArmenian = "O"
    Case &H0549
      TransArmenian = "Ch" & Chr(176)  'Ch-ayin
    Case &H054A
      TransArmenian = "P"
    Case &H054B
      TransArmenian = "J"
    Case &H054C
      TransArmenian = "R" & Chr(242)  'R-dot below
    Case &H054D
      TransArmenian = "S"
      If nNextHex = &H0540 or nNextHex = &H0570 Then
         TransArmenian = "S" & Chr(167)  'S-prime
      End If
    Case &H054E
      TransArmenian = "V"
    Case &H054F
      TransArmenian = "T"
      If nNextHex = &H054D or nNextHex = &H057D Then
         TransArmenian = "T" & Chr(167)  'T-prime
      End If
    Case &H0550
      TransArmenian = "R"
    Case &H0551
      TransArmenian = "Ts" & Chr(176)  'Ts-ayin
    Case &H0552
      TransArmenian = "W"
    Case &H0553
      TransArmenian = "P" & Chr(176)  'P-ayin
    Case &H0554
      TransArmenian = "K" & Chr(176)  'K-ayin
    Case &H0555
      TransArmenian = "O" & Chr(229)  'O-macron
    Case &H0556
      TransArmenian = "F"

    Case &H0561
      TransArmenian = "a"
    Case &H0562
      TransArmenian = "b"
    Case &H0563
      TransArmenian = "g"
      If nNextHex = &H0540 or nNextHex = &H0570 Then
         TransArmenian = "g" & Chr(167)  'g-prime
      End If
    Case &H0564
      TransArmenian = "d"
      If nNextHex = &H0536 or nNextHex = &H0566 Then
         TransArmenian = "d" & Chr(167)  'd-prime
      End If
    Case &H0565
      TransArmenian = "e"
      'If nNextHex = "." Then
      '   TransArmenian = "y"
      'End If
    Case &H0566
      TransArmenian = "z"
      If nNextHex = &H0540 or nNextHex = &H0570 Then
         TransArmenian = "z" & Chr(167)  'z-prime
      End If
    Case &H0567
      TransArmenian = "e" & Chr(229)  'e-macron
    Case &H0568
      TransArmenian = "e" & Chr(233)  'e-hacek
    Case &H0569
      TransArmenian = "t" & Chr(176)  't-ayin
    Case &H056A
      TransArmenian = "zh"
    Case &H056B
      TransArmenian = "i"
    Case &H056C
      TransArmenian = "l"
    Case &H056D
      TransArmenian = "kh"
    Case &H056E
      TransArmenian = "ts"
    Case &H056F
      TransArmenian = "k"
    Case &H0570
      TransArmenian = "h"
    Case &H0571
      TransArmenian = "dz"
    Case &H0572
      TransArmenian = "gh"
    Case &H0573
      TransArmenian = "ch"
    Case &H0574
      TransArmenian = "m"
    Case &H0575
      TransArmenian = "y"
      'If nNextHex = "." Then
      '   TransArmenian = "h"
      'End If
    Case &H0576
      TransArmenian = "n"
    Case &H0577
      TransArmenian = "sh"
    Case &H0578
      TransArmenian = "o"
    Case &H0579
      TransArmenian = "ch" & Chr(176)  'ch-ayin
    Case &H057A
      TransArmenian = "p"
    Case &H057B
      TransArmenian = "j"
    Case &H057C
      TransArmenian = "r" & Chr(242)  'r-dot below
    Case &H057D
      TransArmenian = "s"
      If nNextHex = &H0540 or nNextHex = &H0570 Then
         TransArmenian = "s" & Chr(167)  's-prime
      End If
    Case &H057E
      TransArmenian = "v"
    Case &H057F
      TransArmenian = "t"
      If nNextHex = &H054D or nNextHex = &H057D Then
         TransArmenian = "t" & Chr(167)  't-prime
      End If
    Case &H0580
      TransArmenian = "r"
    Case &H0581
      TransArmenian = "ts" & Chr(176)  'ts-ayin
    Case &H0582
      TransArmenian = "w"
    Case &H0583
      TransArmenian = "p" & Chr(176)  'p-ayin
    Case &H0584
      TransArmenian = "k" & Chr(176)  'k-ayin
    Case &H0585
      TransArmenian = "o" & Chr(229)  'o-macron
    Case &H0586
      TransArmenian = "f"
    Case &H0587
      TransArmenian = "ev"

    
    Case &H0559
      TransArmenian = Chr(176)  'Left half-ring above (approximately an ayn)
    Case &H055A
      TransArmenian = "'"
    Case &H055B
      TransArmenian = ""  'Armenian stress mark; not transliterated
    Case &H055C
      TransArmenian = "!"
    Case &H055D
      TransArmenian = ","
    Case &H055E
      TransArmenian = "?"
    Case &H055F
      TransArmenian = "."
    Case &H0589
      TransArmenian = "."
    Case &H058A
      TransArmenian = "-"
    Case &H058F
      TransArmenian = "[dram]"

    Case &HFB13
      TransArmenian = "mn"
    Case &HFB14
      TransArmenian = "me"
    Case &HFB15
      TransArmenian = "mi"
    Case &HFB16
      TransArmenian = "vn"
    Case &HFB17
      TransArmenian = "mkh"


    Case Else
      TransArmenian = Chr(252)
  End Select
End Function