procedure Delay(Milliseconds: Integer);
var
Tick: DWord;
Event: THandle;
begin
Event := CreateEvent(
nil, False, False,
nil);
try
Tick := GetTickCount + DWord(Milliseconds);
while (Milliseconds > 0)
and
(MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT)
do
begin
Application.ProcessMessages;
if Application.Terminated
then Exit;
Milliseconds := Tick - GetTickcount;
end;
finally
CloseHandle(Event);
end;
end;
// Farbe zwischen 2 vorgegebenen Farbwerten berechnen
function ColorBetween(C1, C2 : TColor; blend:Real):TColor;
var
r, g, b : Byte;
y1, y2 : Byte;
begin
C1 := ColorToRGB(C1);
C2 := ColorToRGB(C2);
y1 := GetRValue(C1);
y2 := GetRValue(C2);
r := Round(y1 + (y2-y1)*blend);
y1 := GetGValue(C1);
y2 := GetGValue(C2);
g := Round(y1 + (y2-y1)*blend);
y1 := GetBValue(C1);
y2 := GetBValue(C2);
b := Round(y1 + (y2-y1)*blend);
Result :=
RGB(r, g, b);
end;
// Farbe zwischen beliebig vielen vorgegebenen Farbwerten berechnen
function ColorsBetween(colors:
array of TColor; blend:Real):TColor;
var
a : Integer;
faktor : Real;
begin
if Length(colors) < 2
then
raise Exception.Create('
ColorsBetween() at least 2 Colors required');
if blend <= 0.0
then
Result := colors[0]
else if blend >= 1.0
then
Result := colors[High(colors)]
else
begin
a := Trunc(High(colors) * blend);
faktor := 1.0 / High(colors);
Result := ColorBetween(colors[a], colors[a+1], (blend-(a * faktor)) / faktor);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i := 1
to 100
do
begin
Label1.Font.Color := ColorsBetween([clBlue, clYellow, clGreen], i / 100);
Delay(40);
end;
end;