Fórum Minimo Multiplo Comum #344369

function MMC(Valores: array of integer): extended;
{para o perfeito funcionamento desta rotina,
 adicione a unit Math na cláusula uses}
var
  fatoracao: array of array[0..1] of integer;
  divisor, i, j, n, d, r: integer;
  ok: boolean;
begin
  result := 1;

  // efetua a fatoração de cada elemento do array
  for r := 0 to High(Valores) do
  begin
    n := Valores[r];
    divisor := 2;

    repeat
      j := 0; ok := false;

      // verifica se é uma divisão exata
      if Frac(n / divisor) = 0 then
        while Frac(n / divisor) = 0 do
        begin
          inc(j);
          n := (n div divisor);
        end;

      if j > 0 then
      begin
        // verifico se a base já não existe na lista
        for d := 0 to High(fatoracao) do
          if fatoracao[d,0] = divisor then
          begin
            ok := true;
            // se a base existir, verifico se o novo expoente é maior
            // do que aquele previamente gravado
            if fatoracao[d,1] < j then
              fatoracao[d,1] := j;
            break;
          end;

        // caso não encontre a base, crio um novo elemento com essa base
        if not ok then
        begin
          SetLength(fatoracao, Length(fatoracao)+1);
          fatoracao[High(fatoracao),0] := divisor;
          fatoracao[High(fatoracao),1] := j;
        end;
      end;

      // incremento o divisor
      if divisor = 2 then
        inc(divisor)
      else
        inc(divisor, 2)
    until (n = 1);
  end;

  // calcula o resultado
  for i := 0 to High(fatoracao) do
    result := result * power(fatoracao[i,0], fatoracao[i,1]);
end;

var
  result_mmc: extended;
begin
  result_mmc := MMC([2, 2, 4, 6, 9]);
  ShowMessage(FloatToStr(result_mmc));

  result_mmc := MMC([36, 90, 72]);
  ShowMessage(FloatToStr(result_mmc));
end;

function MMC(Valores: array of integer): extended;
  procedure Computar(r,i:integer;var fim:integer;var computer:Boolean);
    begin
      if (valores[r] mod i) = 0 Then
         begin
           Computer:=true;
           Valores[r]:=Valores[r] div i
         end;
      fim:=fim*valores[r];
    end;
var
  r,i,Fim:integer;
  computer:boolean;
begin
 i:=2;
 result:=1;
 repeat
   begin
        Fim:=1;
        computer:=False;
        for r:= 0 To high(valores) do
          if Valores[r] > 1 Then
            computar(r,i,fim,computer);
       if computer Then
        result:=result*i
       else
        i:=i+1;
    end;
   until
    (Fim = 1);
end;