[Kassel]

Как создать компоненту перевода арабского числа в римское и обратно??

[Decoding]

Обязательно компонент?

Для начала вот (арабское в римское)

Код:

// Способ первый
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]

А вот и обратная функция

Код:

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;

Долго тестировал, вроде работает нормально...

[Kassel]

Спасибо большое!!!Ты откуда?Если из Оренбурга-то пиши если будут проблемы:вытрясти долги с кого-нибудь, морду набить и т.д.Обращайся не в чём не откажу!И ещё раз спасибо!!!