Vielleicht so:



procedure anpassen(Bild: TBitmap; Grundfarbe: TColor; Prozent: single);

var

x, y, b3: integer;

p: PBytearray;

r, g, b: Byte;

w: word;

begin

if (Prozent = 0) or (Bild.width = 0) or (Bild.height = 0) then exit;

if Prozent > 100 then Prozent := 100;

bild.pixelformat := pf24bit;

Grundfarbe := ColorToRGB(Grundfarbe);

r := getrvalue(Grundfarbe);

g := getgvalue(Grundfarbe);

b := getbvalue(Grundfarbe);

w := r + g + b;

b3 := bild.width * 3;

for y := 0 to bild.height - 1 do begin

p := bild.scanline[y];

x := 0;

while x < b3 do begin

if (abs(w - p[x] - p[x + 1] - p[x + 2]) * 100) / 765 <= Prozent

then begin

p[x] := b;

p[x + 1] := g;

p[x + 2] := r;

end;

inc(x, 3);

end;

end;

end;



procedure TForm1.Button9Click(Sender: TObject);

begin

anpassen(Image1.picture.bitmap, clwhite, 13);

image1.refresh;

end;



Gruß DBR
Eine Stunde denken spart zehn Stunden programmieren!

geschrieben von DBR , 06.02.2006, 19:52 Uhr , 22 mal gelesen