DBR Delphi-Ecke

// Der folgende Code entstand wieder einmal aufgrund einer Mail-Anfrage.
// Es geht um das Prinzip des Spiels "Dobble" bzw. um den Algorithmus,
// welcher dahinter steckt. Man hat 55 Spielkarten und auf jeder befinden
// sich 8 unterschiedliche Bilder. Vergleicht man nun zwei beliebige
// Karten miteinander, dann findet sich genau ein Bild, das auf beiden
// Karten vorhanden ist.
// Zugegeben, ich habe den mathematischen Hintergrund nicht völlig
// durchschaut und etwas empirisch gearbeitet. Deshalb kann meine Lösung
// durchaus vom Original abweichen.
// Der Code erlaubt Kartensätze von 3 bis zu 57 Karten, unter der
// Voraussetzung, dass jede Karte über genau 8 Bilder verfügt und
// dass insgesamt genau 57 unterschiedliche Bilder vorhanden sind.
// Die Prozedur "produce" erzeugt die Matrix "cards" unter der
// Voraussetzung, das die Variable "symbols" genau die angegebnen Werte
// enthält. Die Umsetzung zu Bildern ist hier nicht mit aufgeführt. Man
// kann sich aber beispielsweise vorstellen, man hätte die die Bilder
// Image1 bis Image57 zur Verfügung und Cards[0,0..7] (erste Spielkarte) hat
// die Werte (1, 2, 6, 28, 35, 38, 44, 45), dann müsste man halt die Bilder
// Image1, Image2, Image6, Image28, Image35, Image38, Image44, und Image45
// auf die erste Karte aufbringen.
// Die Prozedur "examine" dient (unter Verwendung von "prove") lediglich
// zur Überprüfung, ob alle Karten genau eine Übereinstimmung enthalten.

// Getestet mit D2010 unter Win7

type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure produce; 
    procedure prove(s1, s2: byte); 
    procedure examine; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
const 
  cardscount = 55; // mindestens 3 bis maximal 57 Karten möglich 
  symbolscount = 8; // unbedingt 8 Bilder pro Karte
  maxsymbols = 57; // unbedingt 57 Bilder müssen verfügbar sein
 
var 
  symbols: array [0 .. symbolscount - 1] of byte = ( 
    0, 
    1, 
    5, 
    27, 
    34, 
    37, 
    43, 
    45 
  ); 
  cards: array [0 .. cardscount - 1, 0 .. symbolscount - 1] of byte; 

  flaw: boolean; // dient nur zum Überprüfungs-Abbruch
 
procedure TForm1.prove(s1, s2: byte); 
var 
  i, k, g: integer; 
  s, z: string; 
begin 
  g := 0; 
  for k := 0 to symbolscount - 1 do 
    for i := 0 to symbolscount - 1 do 
    begin 
      if cards[s1, i] = cards[s2, k] then 
        inc(g); 
    end; 
  if g = 1 then 
    exit; 
  flaw := true; 
  if g = 0 then 
  begin 
    s := 'Keine'; 
    z := ''; 
  end 
  else 
  begin 
    s := 'Mehrere'; 
    z := 'en'; 
  end; 
  showmessage(s + ' Übereinstimmung' + z + ' bei den Karten ' + inttostr(s1) 
      + ' und ' + inttostr(s2)); 
end; 
 
procedure TForm1.examine; 
var 
  x, y: integer; 
begin 
  flaw := false; 
  for x := 0 to cardscount - 3 do 
  begin 
    for y := x + 1 to cardscount - 1 do 
    begin 
      if not flaw then 
        prove(x, y); 
    end; 
  end; 
end; 
 
procedure TForm1.produce; 
var 
  x, y: byte; 
begin 
  for y := 0 to cardscount - 1 do 
  begin 
    for x := 0 to symbolscount - 1 do 
    begin 
      inc(symbols[x]); 
      if symbols[x] > maxsymbols then 
        symbols[x] := symbols[x] - maxsymbols; 
      cards[y, x] := symbols[x]; 
    end; 
  end; 
end; 

 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  produce; // erzeugen 
  examine; // überprüfen 
end;