// Es werden alle
Schattierungen einer Farbe mit Schattierungen einer
// anderen Farbe ersetzt.
// (nicht verwechseln mit
eine Farbe in einem Bitmap vertauschen)
// Dabei sagt die Farbe der Variablen "Schattierung" nur aus welche
// Schattierungen ausgetauscht werden sollen. Es ist also egal, ob man
hier
// "clLime" oder "clGreen" angibt, da ja das eine nur eine Schattierung
des
// anderen ist. Bilder mit vielen hellen Stellen sind ungeeignet, da das
// Ergebnis meist fleckig aussieht.
// Querverweis:
Bitmaps tönen
// Getestet mit D4 unter XP
// --- für alle Varianten ----------------------
function vergleich(r, g, b: byte): byte;
var
r1, g1, b1: byte;
begin
r1 := ord((r > g) and (r > b));
g1 := ord((g > r) and (g > b));
b1 := ord((b > g) and (b > r));
result := r1 or (g1 shl 2) or (b1 shl 4);
end;
// ---------------------------------------------
// Variante 1a: Das ganze Bild wird bearbeitet
// Die Farbe der Variablen "Farbe" ist nicht nur für die neue
// Schattierung da, sondern bestimmt auch deren Helligkeit.
 |
clred
-------------->
$DDFFDD |
 |
| |
|
|
Image1.Canvas.Pixels[1,
1]
-->
$A0FFFF |
 |
procedure changeColor(bm: TBitmap; Schattierung, Farbe: TColor);
var
r1, g1, b1, r2, g2, b2, v, gr: byte;
x, y, b3: integer;
p: pbytearray;
begin
bm.pixelformat := pf24bit;
schattierung := ColorToRGB(schattierung);
r1 := getrvalue(schattierung);
g1 := getgvalue(schattierung);
b1 := getbvalue(schattierung);
Farbe := ColorToRGB(Farbe);
r2 := getrvalue(Farbe);
g2 := getgvalue(Farbe);
b2 := getbvalue(Farbe);
b3 := bm.width * 3;
v := vergleich(r1, g1, b1);
for y := 0 to bm.height - 1 do begin
x := 0;
p := bm.scanline[y];
while x < b3 do begin
if (vergleich(p[x + 2], p[x + 1], p[x]) = v)
then begin
gr := trunc(p[x] * 0.11 + p[x + 1] * 0.59 + p[x + 2] * 0.3);
p[x] := (b2 * gr) shr 8;
p[x + 1] := (g2 * gr) shr 8;
p[x + 2] := (r2 * gr) shr 8;
end;
inc(x, 3);
end;
end;
end;
// Beispielaufrufe
procedure TForm1.Button6Click(Sender: TObject);
begin
changeColor(image1.picture.bitmap, clred, $DDFFDD);
image1.refresh;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
ChangeColor(Image1.picture.bitmap,
Image1.Canvas.pixels[1, 1], $A0FFFF);
image1.refresh;
end;
//--------------------------------------------------------
// Variante 1b: Es werden nur zusammenhängende Teilbereiche rund um einen
// Startpunkt bearbeitet (ähnlich wie bei FloodFill). Weil das
// rekursiv geschieht, darf die neue Schattierung nicht von
// gleicher Art wie die alte sein, da sich sonst das Programm
// totläuft. Außerdem wurde eine Farbaufhellung (1.33) integriert,
// weil der Austausch dunkler Schattierungen gegen wiederum dunkle
// Schattierungen einfach Sch... aussah.
 |
siehe Beispiel |
 |
procedure FloodChangeColor(bm: TBitmap; x, y: integer;
Schattierung, Farbe: TColor);
var
r1, g1, b1, r2, g2, b2, v, gr: byte;
p: pbytearray;
b3: integer;
function tst(i, j: integer): boolean;
begin
result := (i >= b3) or (j >= bm.height)
or (i < 0) or (j < 0);
end;
function frb(bb: byte): byte;
var h: integer;
begin
h := trunc(bb * gr * 1.33) shr 8;
if h > 255 then result := 255 else
result := h;
end;
function pixel(i, j: integer): boolean;
begin
result := false;
if tst(i, j) then exit;
p := bm.scanline[j];
if (vergleich(p[i + 2], p[i + 1], p[i]) = v)
then begin
gr := trunc(p[i] * 0.11 + p[i + 1] * 0.59 + p[i + 2] * 0.3);
p[i] := frb(b2);
p[i + 1] := frb(g2);
p[i + 2] := frb(r2);
if v = vergleich(p[i + 2], p[i + 1], p[i]) then
exit;
result := true;
end;
end;
procedure go(i, j: integer);
var a, b: integer;
begin
for b := j - 1 to j + 1 do begin
a := i - 3;
while a <= i + 3 do begin
if pixel(a, b) then go(a, b);
inc(a, 3);
end;
end;
end;
begin
bm.pixelformat := pf24bit;
b3 := bm.width * 3;
x := x * 3;
if tst(x, y) then exit;
schattierung := ColorToRGB(schattierung);
r1 := getrvalue(schattierung);
g1 := getgvalue(schattierung);
b1 := getbvalue(schattierung);
Farbe := ColorToRGB(Farbe);
r2 := getrvalue(Farbe);
g2 := getgvalue(Farbe);
b2 := getbvalue(Farbe);
v := vergleich(r1, g1, b1);
if v = vergleich(r2, g2, b2) then
raise exception.create('Schattierungen dürfen nicht gleich sein');
go(x, y);
end;
// Beispiel
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button = mbleft then
FloodChangeColor(TImage(sender).picture.bitmap,
x, y, TImage(sender).canvas.pixels[x, y], $8080FF)
else if button = mbright then
FloodChangeColor(TImage(sender).picture.bitmap,
x, y, TImage(sender).canvas.pixels[x, y], $80EEEE);
TImage(sender).refresh;
end;
//--------------------------------------------------------
// Variante 2: Der Nachteil der Variante 1 ist, dass eine veränderte
// Schattierung nicht wieder zurückgerechnet werden kann.
// Deshalb werden bei dieser Variante hier nur die RGB-Werte
// eines Pixels untereinander verschoben. Beim Zurückschieben
// hat man wieder den Originalzustand. Allerdings sind damit
// den Farben der neuen Schattierung enge Grenzen gesetzt.
// Bei _grb und _rgb werden jeweils drei Byte verschoben.
// Diese beiden Methoden heben sich gegenseitig auf. Ansonsten
// werden nur zwei Byte verschoben. Diese Methoden heben sich
// logischwerweise selbst wieder auf.
|
clred --->
_grb |
 |
clgreen ---> _rbg |
|
type
wie = (_grb, _rbg, _gbr, _brg, _rgb);
procedure changeColorx(bm: TBitmap; Schattierung: TColor; art: wie);
var
r1, g1, b1, v, h: byte;
x, y, b3: integer;
p: pbytearray;
begin
bm.pixelformat := pf24bit;
schattierung := ColorToRGB(schattierung);
r1 := getrvalue(schattierung);
g1 := getgvalue(schattierung);
b1 := getbvalue(schattierung);
b3 := bm.width * 3;
v := vergleich(r1, g1, b1);
for y := 0 to bm.height - 1 do begin
x := 0;
p := bm.scanline[y];
while x < b3 do begin
if (vergleich(p[x + 2], p[x + 1], p[x]) = v)
then begin
case art of
_grb: begin
h := p[x];
p[x] := p[x + 1];
p[x + 1] := p[x + 2];
p[x + 2] := h;
end;
_rbg: begin
h := p[x];
p[x] := p[x + 2];
p[x + 2] := p[x + 1];
p[x + 1] := h;
end;
_gbr: begin
h := p[x];
p[x] := p[x + 1];
p[x + 1] := h;
end;
_brg: begin
h := p[x + 1];
p[x + 1] := p[x + 2];
p[x + 2] := h;
end;
_rgb: begin
h := p[x];
p[x] := p[x + 2];
p[x + 2] := h;
end;
end;
end;
inc(x, 3);
end;
end;
end;
// Beispielaufrufe
procedure TForm1.Button9Click(Sender: TObject);
begin
changeColorx(image1.picture.bitmap, clred, _grb);
image1.refresh;
changeColorx(image2.picture.bitmap, clred, _brg);
image2.refresh;
end;
procedure TForm1.Button10Click(Sender: TObject);
begin
changeColorx(image1.picture.bitmap, clgreen, _rbg); // hebt _grb auf
image1.refresh;
changeColorx(image2.picture.bitmap, clgreen, _brg); // hebt sich selbst auf
image2.refresh;
end;
|
