'MacroName:ConvertRomans
'MacroDescription:Converts a number in roman numerals to arabic.
'
' This macro was written by Walter F. Nickeson,
' University of Rochester, Rochester, NY
' wnickeson@library.rochester.edu
'
' Last updated: 23 October 2007.
' Check for the latest versions of this and my other macros at
' http://docushare.lib.rochester.edu/docushare/dsweb/View/Collection-2556
' Please e-mail me with bug reports or to suggest improvements.
'
' Works in Connexion client 2.10.
'
'***************************************************************
' How it works: Select a number written in roman numerals and
' run the macro. It converts the number to its arabic equivalent
' and puts it on the clipboard for pasting.
'
' This macro considers "j" to be equivalent to "i".
'***************************************************************

Option Explicit

Sub Main

Dim CS As Object
Set CS = CreateObject("Connex.Client")

Dim RomanString$
Dim Selection$

Dim ArValue%                 : ArValue% = 0
Dim a, b, c, d As Integer

Dim Romans() As Integer

' First, make sure some text is selected

If CS.GetSelectedText( Selection$ ) = FALSE Then
    MsgBox "Select some text to convert!", 64, "No text selected"
    GoTo Done:
End If

' Convert the string to uppercase for manipulation

RomanString$ = Trim$( UCase( Selection$ ) )

' Remove spaces and periods

Do
  a = InStr( RomanString$, " " )
  If a > 0 Then RomanString$ = Left$( RomanString$, a - 1 ) & Mid$( RomanString$, a + 1 )
Loop Until a = 0

Do
  b = InStr( RomanString$, "." )
  If b > 0 Then RomanString$ = Left$( RomanString$, b - 1 ) & Mid$( RomanString$, b + 1 )
Loop Until b = 0

' Stuff the values of each of the roman numerals into an array

ReDim Preserve Romans( 0 To Len( RomanString$ ) + 1 ) As Integer
For c = 0 To Len( RomanString$ ) - 1
  Select Case Mid$( RomanString$, c + 1, 1 )
    Case "M"
      Romans( c ) = 1000
    Case "D"
      Romans( c ) = 500
    Case "C"
      Romans( c ) = 100
    Case "L"
      Romans( c ) = 50
    Case "X"
      Romans( c ) = 10
    Case "V"
      Romans( c ) = 5
    Case "I", "J"
      Romans( c ) = 1
    Case Else
      MsgBox "Non-roman numeral found!--" & Chr$( 034 ) & Mid$( RomanString$, c + 1, 1 ) & Chr$ ( 034 ) & ".", 48, "Illegal character"
      GoTo Done:
  End Select
Next c

' Since the value of a character depends on the succeeding
' character, add a dummy value as the last piece in the array
' for correctly evaluating the last character in the string

Romans( c + 1 ) = 0

' Evaluate the arabic equivalent. If a character is greater in
' value than the one following it, its value is simply added to
' the running total; if not, its value is subtracted from the
' value of the following character, and that subtotal then added
' to the running total

For d = 0 To Len( RomanString$ ) - 1
  If Romans( d ) < Romans( d + 1 ) Then
      ArValue% = ArValue% + ( Romans( d + 1 ) - Romans( d ) )
      d = d + 1
    Else
      ArValue% = ArValue% + Romans( d )
  End If
Next d

MsgBox Chr$( 034 ) & Selection$ & Chr$( 034 ) & " = " & CStr( ArValue% ), 64, "Arabic numeral value"
Clipboard.Clear
Clipboard.SetText Trim$( Str$( ArValue% ) )

Done:

End Sub