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;