|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
ПЛИЗ Help!!!(срочняк)
Как создать компоненту перевода арабского числа в римское и обратно??
|
#2
|
||||
|
||||
Обязательно компонент?
Для начала вот (арабское в римское) Код:
// Способ первый function IntToRoman( num: Cardinal ): string; const N = 13; vals: array [1..N] of word = ( 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000 ); roms: array [1..N] of string[2] = ( 'I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' ); var b: 1..N; begin Result := ''; b := N; while num > 0 do begin while vals[b] > num do Dec( b ); Dec( num, vals[b] ); Result := Result + roms[b]; end; end; procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage( IntToRoman( 1561 ) ); end; // Способ второй function IntToRoman( num: Cardinal ): string; const N = 13; vals: array [1..N] of word = ( 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000 ); roms: array [1..N] of string[2] = ( 'I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' ); var b: 1..N; begin Result := ''; b := N; while ( num > 0 ) and ( b >= 1 ) do begin if num >= vals[b] then begin Result := Result + roms[b]; Dec( num, vals[b] ); end else Dec( b ); end; end; procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage( IntToRoman( 1561 ) ); end; Обратное действие посложнее будет, там надо будет парсер писать... Попробуй самостоятельно (по аналогии)... По поводу компонента... В инете про это много написано, не вижу смысла повторять все это тут... Ну а если не справишься, пиши, постораюсь помочь (чем смогу)... Последний раз редактировалось Decoding, 11.11.2006 в 22:04. |
#3
|
||||
|
||||
А вот и обратная функция
Код:
function RomanToInt( num: string ): integer; const N = 13; vals: array [1..N] of word = ( 4, 9, 40, 90, 400, 900, 1, 5, 10, 50, 100, 500, 1000 ); roms: array [1..N] of string[2] = ( 'IV', 'IX', 'XL', 'XC', 'CD', 'CM', 'I', 'V', 'X', 'L', 'C', 'D', 'M' ); var i: integer; begin Result := 0; while Length( num ) > 0 do begin for i := Low( roms ) to High( roms ) do if AnsiUpperCase( Copy( num, 1, Length( roms[i] ) ) ) = roms[i] then begin Inc( Result, vals[i] ); Delete( num, 1, Length( roms[i] ) ); Break; end; end; end; |
#4
|
|||
|
|||
Decoding
Спасибо большое!!!Ты откуда?Если из Оренбурга-то пиши если будут проблемы:вытрясти долги с кого-нибудь, морду набить и т.д.Обращайся не в чём не откажу!И ещё раз спасибо!!!
|