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

[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.

 

[NickProstoNick]

вот нарыл такое. правда на паскале...

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;

вот набрасал на скрипте на скорую руку

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

 

[oshmianski]

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

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

 

[NickProstoNick]

для пущей гибкости кода думаю надо сделать так... правда если есть эквивалент в римской системе выше 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

 

[Murtas]

%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

а шо эта за крутая система документирования?

 

[oshmianski]

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

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