// Mit dem folgenden Code findet man den größten bzw. kleinsten
// gemeinsamen Teiler von mehreren ganzen positiven Zahlen.


// Getestet mit D4 unter XP

function findK(ac: array of cardinal): cardinal; 
var x: integer; 
begin 
  result := length(ac); 
  if result = 0 then exit; 
  result := 4294967295; 
  for x := 0 to high(ac) do 
    if ac[x] < result then result := ac[x]; 
end; 
 
function tst(ac: array of cardinal; c: cardinal): boolean; 
var x: integer; 
begin 
  for x := 0 to high(ac) do 
     if frac(ac[x] / c) > 0 then begin
      result := false; 
      exit; 
    end; 
  result := true; 
end; 
 
function tstg(ac: array of cardinal; K: cardinal): cardinal; 
begin 
  result := 1; 
  while K > 1 do begin 
    if tst(ac, K) 
      then begin 
      result := K; 
      break; 
    end; 
    dec(K); 
  end; 
end; 
 
function tstk(ac: array of cardinal; K: cardinal): cardinal; 
var c: cardinal; 
begin 
  result := 1; 
  c := 2; 
  while c <= K do begin 
    if tst(ac, c) 
      then begin 
      result := c; 
      break; 
    end; 
    inc(c); 
  end; 
end; 
 
function GmT(ac: array of cardinal; groesster: boolean): cardinal; 
begin 
  result := findK(ac); 
  if result < 2 then exit; 
  if groesster then 
    result := tstg(ac, result) 
  else result := tstk(ac, result); 
end; 
 
function GgT(ac: array of cardinal): cardinal; 
begin 
  result := GmT(ac, true); 
end; 
 
function KgT(ac: array of cardinal): cardinal; 
begin 
  result := GmT(ac, false); 
end; 
 
 
// Beispielaufrufe 
 
procedure TForm1.Button4Click(Sender: TObject); 
var c: cardinal; 
begin 
  c := GgT([665, 133, 1862]); 
  if c < 2 then showmessage('Größter gemeinsamer Teiler wurde nicht gefunden.') 
  else showmessage('Größter gemeinsamer Teiler ist ' + inttostr(c)); 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
var c: cardinal; 
begin 
  c := KgT([665, 133, 1862]); 
  if c < 2 then showmessage('Kleinster gemeinsamer Teiler wurde nicht gefunden.') 
  else showmessage('Kleinster gemeinsamer Teiler ist ' + inttostr(c)); 
end; 


Zugriffe seit 6.9.2001 auf Delphi-Ecke