1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

function farbe (basisfarbe : integer; stufe :byte) : integer;
var
hexcol : string;
r,g,b : integer;
rn,gn,bn : integer;
const
factor = 10;
begin
hexcol := inttohex(basisfarbe,6);
r := strtoint('$'+copy(hexcol,5,2));
g := strtoint('$'+copy(hexcol,3,2));
b := strtoint('$'+copy(hexcol,1,2));
rn := r-(factor*stufe);
gn := g-(factor*stufe);
bn := b-(factor*stufe);
if rn < 0 then rn := 0;
if gn < 0 then gn := 0;
if bn < 0 then bn := 0;
result := strtoint('$' + inttohex(bn,2) + inttohex(gn,2) + inttohex(rn,2));
end;                    

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject);
begin
form1.color := farbe(clred,3);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

function farbe (basisfarbe : integer; stufe : integer) : integer;
var
hexcol : string;
r,g,b : integer;
rn,gn,bn : integer;
begin
hexcol := inttohex(basisfarbe,6);
r := strtoint('$'+copy(hexcol,5,2));
g := strtoint('$'+copy(hexcol,3,2));
b := strtoint('$'+copy(hexcol,1,2));
rn := r-stufe);
gn := g-stufe);
bn := b-stufe);
if rn < 0 then rn := 0;
if gn < 0 then gn := 0;
if bn < 0 then bn := 0;
result := strtoint('$' + inttohex(bn,2) + inttohex(gn,2) + inttohex(rn,2));
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:

function Min(a, b: Longint): Longint; 
begin 
  if a > b then Result := b  
  else  
    Result := a; 
end; 

function Max(a, b: Longint): Longint; 
begin 
  if a > b then Result := a  
  else  
    Result := b; 
end; 

{=======================================} 

function GetHighlightColor(BaseColor: TColor): TColor; 
begin 
  Result := RGB(Min(GetRValue(ColorToRGB(BaseColor)) + 64, 255), 
    Min(GetGValue(ColorToRGB(BaseColor)) + 64, 255), 
    Min(GetBValue(ColorToRGB(BaseColor)) + 64, 255)); 
end; 


function GetShadowColor(BaseColor: TColor): TColor; 
begin 
  Result := RGB(Max(GetRValue(ColorToRGB(BaseColor)) - 64, 0), 
    Max(GetGValue(ColorToRGB(BaseColor)) - 64, 0), 
    Max(GetBValue(ColorToRGB(BaseColor)) - 64, 0)); 
end; 

procedure ShowForms;
var
  i:Integer;
begin
  for i:=0 to Screen.FormCount -1 do begin
    Screen.Forms[i].Show;
    if i >= 1 then begin
//      ShowMessage(IntTostr(i));
      Screen.Forms[i-1].Color:=GetShadowColor(Screen.Forms[i-1].Color);
    end;
  end;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ShowForms
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:

function farbe (basisfarbe : integer; stufe :byte) : integer;
var
hexcol : string;
r,g,b : integer;
rn,gn,bn : integer;
const
factor = 10;
begin
hexcol := inttohex(basisfarbe,6);
r := strtoint('$'+copy(hexcol,5,2));
g := strtoint('$'+copy(hexcol,3,2));
b := strtoint('$'+copy(hexcol,1,2));
rn := r-(factor*stufe);
gn := g-(factor*stufe);
bn := b-(factor*stufe);
if rn < 0 then rn := 0;
if gn < 0 then gn := 0;
if bn < 0 then bn := 0;
result := strtoint('$' + inttohex(bn,2) + inttohex(gn,2) + inttohex(rn,2));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
form2.show;
form3.show;
form4.show;

for i := 0 to screen.formcount-1 do
begin
 screen.Forms[i].Color := farbe(clInfoBK,i);
end;

end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

procedure ShowForms;
var
  i:Integer;
begin
  Screen.Forms[0].Show;
  Screen.Forms[1].Show;
  Screen.Forms[2].Show;
  Screen.Forms[3].Show;
  Screen.Forms[4].Show;        
  
  for i:=Screen.FormCount -1 DownTo 0 do begin
    Screen.Forms[i].Show;
    Screen.Forms[i].Color:=farbe(clInfoBK,i); ;
  end;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ShowForms
end;                    

1:
2:
3:
4:
5:

case Ebene of
  1 : MeineForm.Color := clInfoBK
  2 : MeineForm.Color := clInfoBK -+ ??????`
....
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:

unit Unit23;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TPixelBMP24 = packed record
    R: byte;
    G: byte;
    B: byte;
end;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button2: TButton;
    Button1: TButton;
    procedure ListBox1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    Grundfarbe: longint;
    Ebene: integer;
    Procedure SetzeFormFarbe;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function BMPRGBtoYUV(rgb: TPixelBMP24): TPixelBMP24;
//von der DSlibrary von delphi-source.de
var y,u,v:longint;
begin
  y := rgb.G*150 + rgb.B*29 + rgb.R*77; // 0.587 x 256, 0.114 x 256, 0.299 x 256
  u := (rgb.B shl 8 - y) * 144;         // 0.564 x 256
  v := (rgb.R shl 8 - y) * 183;         // 0,713 x 256
  Result.G :=y shr 8;
  Result.B :=u shr 16 + $80;
  Result.R :=v shr 16 + $80;
end;

function BMPYUVtoRGB(yuv: TPixelBMP24): TPixelBMP24;
//von der DSlibrary von delphi-source.de
var temp: integer;
begin
  temp := yuv.G + (yuv.B - $80) * 256 div 144  ;
  if temp > 0 then Result.B:=temp else Result.B:=0;
  if temp > 255 then Result.B:=255;

  temp := yuv.G + (yuv.R - $80) * 256 div 183  ;
  if temp > 0 then Result.R:=temp else Result.R:=0;
  if temp > 255 then Result.R:=255;

  temp := (yuv.G shl 8 - Result.B*29 - Result.R*77) div 150;
  if temp > 0 then Result.G:=temp else Result.G:=0;
  if temp > 255 then Result.G:=255;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  if Listbox1.ItemIndex<>-1 then
    begin
      ebene:=Listbox1.ItemIndex;
      SetzeFormFarbe;
    end;
end;

procedure TForm1.SetzeFormFarbe;
Var _rgb:TPixelBMP24;
    yuv : TPixelBMP24;
    temp:integer;
    y,u,v,r,g,b:byte;
begin

  //Fabrbe in RGB werte aufsplitten
  _rgb.r:=GetRValue(Grundfarbe);
  _rgb.g:=GetGValue(Grundfarbe);
  _rgb.b:=GetBValue(Grundfarbe);
  //Farbe in Yuv - werte ändern
  yuv:=BMPRGBtoYUV(_rgb);

  temp:=yuv.G-Ebene*20;  //Helligkeitsabstufung an hand der ebene
  if temp<0 then temp:=0;
  yuv.G:=temp;

  _rgb:=BMPYUVtoRGB(yuv); //und wieder zurück zu RGB
  //Formfarbe setzen
  Color := rgb(_rgb.R,_rgb.G,_rgb.B);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //beispiel 1
  Grundfarbe:=rgb(255,255,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //beispiel 2
  Grundfarbe:=colortorgb(clInfoBk);
  //colortorgb ist wichtig, wenn du Tcolor werte verwendest
end;

procedure TForm1.FormCreate(Sender: TObject);
Var i:integer;
begin
  //zum ausprobieren
  for i:=0 to 9 do
    ListBox1.Items.Add('Ebene '+inttostr(i));
end;

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

program Project1;

uses
  Forms, Windows, System,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2},
  Unit3 in 'Unit3.pas' {Form3},
  Unit4 in 'Unit4.pas' {Form4};

{$R *.res}

var
  i: Integer;
begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm2, Form2);
  Application.CreateForm(TForm3, Form3);
  Application.CreateForm(TForm4, Form4);

  for i := 1 to Screen.FormCount -1 do
  begin
    Screen.Forms[i].Color := RGB(i*10, i*20, i*30);
  end;

  Application.Run;
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:

procedure TForm1.Button1Click(Sender: TObject);
Var grundfarbe:longint;
    temp:integer;
    i:integer;
    _rgb:TPixelBMP24;
    yuv : TPixelBMP24;
begin
  Grundfarbe:=colortorgb(clBtnHighlight);
//  Grundfarbe:=rgb(255,200,0);

  //Variante 1 - yuv
  //Fabrbe in RGB werte aufsplitten
  _rgb.r:=GetRValue(Grundfarbe);
  _rgb.g:=GetGValue(Grundfarbe);
  _rgb.b:=GetBValue(Grundfarbe);
  //Farbe in Yuv - werte ändern
  yuv:=BMPRGBtoYUV(_rgb);

  for i:=255 downto 0 do
    begin
       //Helligkeitsabstufung an hand der ebene
      if yuv.G>0 then dec(yuv.G);
      _rgb:=BMPYUVtoRGB(yuv); //und wieder zurück zu RGB
      //Formfarbe setzen
      PaintBox1.Canvas.Pen.Color := rgb(_rgb.R,_rgb.G,_rgb.B);
      PaintBox1.Canvas.moveto(i,0);
      PaintBox1.Canvas.lineto(i,150);
    end;

  //Variante 2 rgb-werte verringern
  //Fabrbe in RGB werte aufsplitten
  _rgb.r:=GetRValue(Grundfarbe);
  _rgb.g:=GetGValue(Grundfarbe);
  _rgb.b:=GetBValue(Grundfarbe);

  for i:=255 downto 0 do
    begin
      if _rgb.r>0 then dec(_rgb.r);
      if _rgb.g>0 then dec(_rgb.g);
      if _rgb.b>0 then dec(_rgb.b);
      //Formfarbe setzen
      PaintBox2.Canvas.Pen.Color := rgb(_rgb.R,_rgb.G,_rgb.B);
      PaintBox2.Canvas.moveto(i,0);
      PaintBox2.Canvas.lineto(i,150);
    end;
end;                    

1:

TPixelBMP24;                    

1:
2:
3:
4:
5:
6:

type 
  TPixelBMP24 = packed record 
    R: byte; 
    G: byte; 
    B: byte; 
end;