Buscar por:

Algarismos Romanos com barra sobre as milhares

Código

(*

Atualmente, no sistema romano-MODERNO, chama-se de vinculum a uma barra colocada em cima de um algarismo ou parte de um numeral. O algarismo ou parte de numeral por debaixo de um vinculum fica valendo mil vezes mais, e é somado ao eventual resto do algarismo.

A rotina abaixo, converte algarismos arábicos para romanos colocando esta barra utilizando o canvas do form.

Vale observar que a procedure depende da um componente do tipo TLabel para funcionar corretamente. Este TLabel será passado por parâmetro e mostrará o resultado da conversão.

*)

//Rotina para conversão de algarismos arábicos para romanos usando canvas.

//Por Márcio Rocha Dias

procedure TForm1.ArabicoParaRomano(AlgArabico: double; objSaida: Tobject);

const

  Arabicos                         : array[0..12] of Integer = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);

  Romanos                          : array[0..12] of string = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');

var

  i, x                             : Integer;

  bColocarMacron                   : boolean;

  Resultado                        : string;

  valor                            : string;

  Milhar                           : string;

  {Procedure responsável por desenhar o macron (traço sobre as milhares acima de 3999}

  procedure ColocarMacron(caracter: string; pColocarMacron: boolean);

  begin

    Canvas.FillRect(Rect(0, 0, 640, 480));

    Canvas.Refresh;

    if pcolocarMacron then

    begin

      TLabel(objSaida).Caption := caracter;

      Canvas.Font := TLabel(objSaida).Font;

      Canvas.Font.Size := TLabel(objSaida).Font.Size;

      Canvas.Pen.Width := 5;

      Canvas.MoveTo(TLabel(objSaida).Left + 1, TLabel(objSaida).Top - TLabel(objSaida).Height);

      Canvas.Rectangle(TLabel(objSaida).Left, TLabel(objSaida).top, TLabel(objSaida).Left + TLabel(objSaida).Width, TLabel(objSaida).top - 1);

    end;

  end;

begin

  Valor := '0';

  Resultado := '';

  bColocarMacron := false;

  if AlgArabico <= 3999999 then

  begin

    if AlgArabico > 3999 then

    begin

      valor := copy(floattostr(AlgArabico), length(floattostr(AlgArabico)) - 2, length(floattostr(AlgArabico)));

      AlgArabico := trunc(AlgArabico) div 1000;

      bColocarMacron := True;

    end;

    for x := 1 to 2 do

    begin

      if x > 1 then

      begin

        AlgArabico := StrToFloat(valor);

      end;

      for i := 12 downto 0 do

      begin

        while (AlgArabico >= Arabicos[i]) do

        begin

          AlgArabico := AlgArabico - Arabicos[i];

          Resultado := Resultado + Romanos[i];

        end;

      end;

      if x = 1 then

      begin

        Milhar := Resultado;

      end;

    end;

    ColocarMacron(Milhar, bColocarMacron);

    TLabel(objSaida).Caption := Resultado;

  end else

  begin

    showmessage('Esta rotina não é capaz de converter este número');

  end;

end;