Арабские цифры в римские

Тема в разделе "Lotus - Программирование", создана пользователем oshmianski, 6 мар 2009.

  1. oshmianski

    oshmianski Гость

    Возможно кто-то сталкивался и может поделиться?
    1-> I
    2-> II
    3->III
    4->IV
    ну, и так далее.

    Все это безобразие должно происходить в MS Word чере OLE на скрипте.

    Оговорюсь, что список (средствами MS Word) делать неэффективно (ну, или я пока не вижу этой эффективности).
    Может есть шрифт или стандартный макрос какой?
    Очевидное решение - на скрипте делать список вида list (1) = "I", list (2) = "II" и т.д.. Но размерность по любому будет ограничена.
    Может есть более элегантное решение?

    LND 6-7, MS Office 2000-2003-2007.
     
  2. NickProstoNick

    NickProstoNick Статус как статус :)

    Регистрация:
    22 авг 2008
    Сообщения:
    1.766
    Симпатии:
    39
    вот нарыл такое. правда на паскале...
    Код (Text):
    function IntToRoman(num: Cardinal): String; {returns num in capital roman digits}
    const
    Nvals = 13; // константа
    {константные массивы}
    vals: array [1..Nvals] of word = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
    roms: array [1..Nvals] of string[2] = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
    Var
    b: 1..Nvals; // раннжированая переменая
    begin
    Result:=''; // результат пустой
    b := Nvals; // установим максимальный размер переменой b
    While num > 0 do // пока num больше 0 продолжаем в цикле
    begin
    while vals[b] > num do dec(b); //пока элементы массива больше num уменьшаем b
    dec (num, vals[b]); // уменьшим num на елемент массива vals c индексом b
    result := result + roms[b]; // допишем строку результата
    end;
    end;

    вот набрасал на скрипте на скорую руку
    Код (Text):
    Function IntToRoman( num As Variant ) As String
    Dim tmp As Variant
    Dim vals( 12 ) As Long
    Dim roms As Variant

    tmp = Fulltrim( Split( "1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000", ", " ) )
    roms = Fulltrim( Split( "I, IV, V, IX, X, XL, L, XC, C, CD, D, CM, M", ", " ) )

    For i = 0 To Ubound( vals )
    vals(i) = Clng( tmp(i) ) ' переводим в тип Long
    Next

    IntToRoman ="" ' результат пустой
    b = Ubound( vals ) ' установим максимальный размер переменой b

    While num > 0 ' пока num больше 0 продолжаем в цикле

    While vals(b) > num
    b = b -1 ' пока элементы массива больше num уменьшаем b          
    Wend

    num = num - vals(b) ' уменьшим num на елемент массива vals c индексом b
    IntToRoman = IntToRoman + roms(b) ' допишем строку результата

    Wend

    End Function
     
  3. oshmianski

    oshmianski Гость

    NickProstoNick
    Благодарствую.
    Позволил себе несколько подкорректировать скрипт.

    Код (Text):
    Function IntToRoman (num As Variant, out As String) As Boolean
    %REM
    <information>
    <description>
    Функция преобразует арабское число в римское строковое.
    </description>

    <input params>
    num - арабское число. Variant.
    </input params>

    <output params>
    out - число в римском формате. String.
    </output params>

    <result>
    true - функция выполнена нормально.
    false - функция выполнена с ошибкой.
    </result>

    <others>
    ...
    </others>
    </information>
    %END REM
    On Error Goto errorHandler

    IntToRoman = False         

    Dim tmp As Variant
    Dim roms As Variant
    Dim numInner As Variant

    Dim vals (12) As Long

    Dim b As Integer
    Dim i As Integer

    numInner = num
    out = "" ' результат пустой 

    tmp = Fulltrim (Split ( "1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000", ", "))
    roms = Fulltrim(Split ( "I, IV, V, IX, X, XL, L, XC, C, CD, D, CM, M", ", "))

    For i = 0 To Ubound (vals)
    vals (i) = Clng (tmp (i)) ' переводим в тип Long
    Next       

    b = Ubound (vals) ' установим максимальный размер переменой b

    While numInner > 0 ' пока numInner больше 0 продолжаем в цикле

    While vals (b) > numInner
    b = b -1 ' пока элементы массива больше numInner уменьшаем b         
    Wend

    numInner = numInner - vals (b) ' уменьшим numInner на елемент массива vals c индексом b
    out = out + roms (b) ' допишем строку результата

    Wend

    IntToRoman = True
    ex:
    Exit Function

    errorHandler:
    Call ProcessError (MODULE_NAME, Err, Error, Erl, Lsi_info(2), Lsi_info(12))
    Resume ex
    End Function
     
  4. NickProstoNick

    NickProstoNick Статус как статус :)

    Регистрация:
    22 авг 2008
    Сообщения:
    1.766
    Симпатии:
    39
    для пущей гибкости кода думаю надо сделать так... правда если есть эквивалент в римской системе выше 1000

    вместоDim vals (12) As Long надо написать Dim vals () As Long

    а после roms = Fulltrim(Split ( "I, IV, V, IX, X, XL, L, XC, C, CD, D, CM, M", ", "))
    написать Redim vals( Ubound( tmp ) ) As Long
     
  5. Murtas

    Murtas Well-Known Member

    Регистрация:
    11 апр 2006
    Сообщения:
    123
    Симпатии:
    0
    а шо эта за крутая система документирования?
     
  6. oshmianski

    oshmianski Гость

    NickProstoNick
    _http://ru.wikipedia.org/wiki/Римские_цифры

    Murtas
    Ну, крутой ее вряд ли можно назвать.
    Просто у нас так принято.
    Возможно может пригодится при экспорте скриптов в другие IDE.
     
Загрузка...

Поделиться этой страницей