Unterschiedliche Farben generieren

[SirThornberry]

Hier der Source

Delphi-Quellcode:

function IsSameConsideringRange(Val1, Val2: Integer; ARange: Word = 5): Boolean;
begin
  result := (Val1 >= Val2 - ARange) and (Val1 <= Val2 + ARange);
end;

procedure TForm1.Button1Click(Sender: TObject);
var LRed, LGreen, LBlue, LMindestabstand: Byte;
    LFarben: Array of TColor;
    LIsNew: Boolean;
    LCount1, LCountFarben: Integer;
begin
  LMindestabstand := 60;  //Legt Fest wie ähnlich sich die farben sein dürfen. Je kleiner die Zahl destso ähnlicher dürfen sich die farben werden. Man sollte allderdings bedenken das es zu einer Endlosschleife werden kann wenn man den wert zu hoch setzt weil es irgendwann bei zu viel farben keine farbe mehr gibt die dann anders aussieht
  for LCountFarben := 1 to 40 do  //anzahl der Farben die erzeugt werden soll
  begin
    repeat
      LIsNew := True;
      LRed := Random(256);
      LGreen := Random(256);
      LBlue := Random(256);
      for LCount1 := 0 to length(LFarben) - 1 do
      begin
        if IsSameConsideringRange(LRed, GetRValue(LFarben[LCount1]), LMindestabstand) and
           IsSameConsideringRange(LGreen, GetGValue(LFarben[LCount1]), LMindestabstand) and
           IsSameConsideringRange(LBlue, GetBValue(LFarben[LCount1]), LMindestabstand) then
        begin
          LIsNew := False;
          break;
        end;
      end;
    until LIsNew;
    setlength(LFarben, length(LFarben)+1);
    LFarben[length(LFarben)-1] := RGB(LRed, LGreen, LBlue);
  end;

  //farben testweise auf Image1 ausgeben
  image1.Picture.Bitmap.Width := image1.Width;
  image1.Picture.Bitmap.Height := image1.Height;
  for LCount1 := 0 to length(LFarben)-1 do
  begin
    Image1.Picture.Bitmap.Canvas.Brush.Color := LFarben[LCount1];
    Image1.Picture.Bitmap.Canvas.FillRect(Rect(0, LCount1 * 10, Image1.Width, LCount1 * 10 + 10));
  end;
end;