TImage Bitmap farbtausch

Niko S. · Verfasst: So 08.07.07 16:29

Ist es möglich, dass ich sagen kann "farbe" mit "farbe" vertauschen?
also das aus blau halt grün wird z.b. wenn ein bitmap geladen ist .

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Jupp, alle Pixel durchgehen und auf Farbwert prüfen und dann ändern

.

markieren

Delphi-Quelltext

1:	if BMP.Canvas.Pixels[1,1] = clGreen then BMP.Canvas.Pixels[1,1]:=clBlue

Niko S. · Verfasst: So 08.07.07 16:55

hm .. super idee nur bei einem 700x800 bild ... dauert das und geht in die knie .
geht das auch schneler ( resourcen schonnender) ?? weil die antialiasing function die ich gefunden hab geht super schnell.

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Jupp, Scanline ist schneller.

Niko S. · Verfasst: So 08.07.07 17:09

blubb scanline hat doch nur 3 funktionen wie tut man den dann Farbe 1 in Farbe 2 tauschen?
Farbe 2 wird ja ermittelt und ist eine TColor

Heiko · Beiträge: 3169 Erhaltene Danke: 11

markieren

Delphi-Quelltext

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

  PRGB = ^TRGB;
  TRGB = packed record
    B, G, R: Byte;
  end;
//...

BMP.PixelFormat:=pf24bit;
//...

var
  p: PRGB;
  i: integer;
//..
  p:=BMP.ScanLine[BMP.Height-1];
  for  i:= (BMP.Height*BMP.Width)-1 downto 0 do
  begin
    if (p^.R=0) and (p^.G=255) and (p^.B=0) then
    begin
      p^.B:=255;
      p^.G:=0;
      p^.R:=0;
    end;
    inc(p);
  end;

Niko S. · Verfasst: So 08.07.07 17:47

danke für die schnellen antworten ich habs mal getestet.
Aber es funktioniert nicht er ließt zwar die farben aus aber überschreibt sie denn nicht.
Er sollte zwar laut quelltext die neuen farben setzen (was er auch eigendlich macht weil in der if reingehen tut er ja) aber er setzt das irgendwie nicht um

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Dein Code, falls er nicht zu lang ist (komplettes Paket bitte)? Denn ich habs nur aus einm projekt von mir kopiert (mit leichten Modifikationen, da mein Source was anderesw macht

).

Niko S. · Verfasst: So 08.07.07 17:57

markieren

Delphi-Quelltext

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

procedure TForm1.Label1Click(Sender: TObject);
type
  PRGB = ^TRGB;
  TRGB = packed record
    B, G, R: Byte;
  end;
var
  p: PRGB;
  i: integer;
begin
  p:=Image1.picture.bitmap.ScanLine[Image1.Height-1];
  for  i:= (Image1.Height*Image1.Width)-1 downto 0 do
  begin
    if (p^.R=255) and (p^.G=0) and (p^.B=255) then
    begin
      p^.B:=35;
      p^.G:=35;
      p^.R:=35;
    end;
    inc(p);
  end;
end;

Heiko · Beiträge: 3169 Erhaltene Danke: 11

kk, so wollte ich es eigentlich nicht haben, aber egal. Da schreibe ich eben nen paar zeilen mehr

.

Folgendes funktioniert. Warum das mit for i:=(BMP.Width-1)*(Bmp.Height-1) downto 0 nicht funktioniert, weiß iich jetzt nicht. Habe aber auch keine Lust zu debuggen

.

markieren

Delphi-Quelltext

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:

procedure TForm1.FormClick(Sender: TObject);
type
  PRGB = ^TRGB;
  TRGB = packed record
    B, G, R: Byte;
  end;
var
  p: PRGB;
  x, y: integer;
begin
  for y := BMP.Height-1 downto 0 do
  begin
    p:=BMP.ScanLine[y];
    for x := BMP.Width-1 downto 0 do
    begin
      if (p^.R=255) and (p^.G=0) and (p^.B=0) then
      begin
        p^.B:=35;
        p^.G:=35;
        p^.R:=35;
      end;
      inc(p);
    end;
  end;
  BitBlt(PaintBox1.Canvas.Handle, 0, 0, BMP.Width, BMP.Height, BMP.Canvas.Handle, 0, 0, SRCCOPY)
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BMP.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BMP:=TBitmap.Create;
  BMP.PixelFormat:=pf24bit;
  BMP.Width:=PaintBox1.Width;
  BMP.Height:=PaintBox1.Height;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  with BMP.Canvas do
  begin
    Pen.Color:=RGB(255, 0, 0);
    Brush.Color:=Pen.Color;
    Rectangle( 0,  0, BMP.Width- 1, BMP.Height- 1);
    Pen.Color:=RGB(0, 255, 0);
    Brush.Color:=Pen.Color;
    Rectangle(10, 10, BMP.Width-10, BMP.Height-10);
  end;
  BitBlt(PaintBox1.Canvas.Handle, 0, 0, BMP.Width, BMP.Height, BMP.Canvas.Handle, 0, 0, SRCCOPY)
end;

Narses · Verfasst: So 08.07.07 23:36

Moin!

Simak hat folgendes geschrieben:

markieren

Delphi-Quelltext

1:
2:
3:

p:=Image1.picture.bitmap.ScanLine[Image1.Height-1];
  for  i:= (Image1.Height*Image1.Width)-1 downto 0 do
  begin

1. Bitmaps können sowohl "hängen", als auch "liegen", deshalb immer durch das .Scanlines[]-Array laufen! :mahn:

Simak hat folgendes geschrieben:

markieren

Delphi-Quelltext

1:	if (p^.R=255) and (p^.G=0) and (p^.B=255) then

2. Wer hat garantiert, dass das Bild im pf24Bit vorliegt? :nixweiss:

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Narses hat folgendes geschrieben:

1. Bitmaps können sowohl "hängen", als auch "liegen", deshalb immer durch das .Scanlines[]-Array laufen! :mahn:

Ist klar, aber bisher war es immer von unten nach oben. Das Delphi-BMP untserstützt vermutlich auch nur das, oder kann man eigentlich auslesen, wierum es steht? Denn da bräuchte Delphi ja intern auch, falls er es auch mal gespiegelt hat.

Simak hat folgendes geschrieben:

2. Wer hat garantiert, dass das Bild im pf24Bit vorliegt? :nixweiss:

Ein paar Posts darüber habe ich dass mit drin. Ich glaube, er hats nur nicht mitgepostet.

Niko S. · Verfasst: Mo 09.07.07 12:01

Narses hat folgendes geschrieben:

2. Wer hat garantiert, dass das Bild im pf24Bit vorliegt? :nixweiss:

Ne das ist schon richtig für mein Versuch sind es pf24Bit Bitmaps.
Ich hatte versucht ein programm was designed ist mit sonem, (wie soll ich das ausdruecken) so ein undgleichförmiger Rand halt.
und das ist immer pixlig und ich wollte ermitteln welche hitnergrundfarbe der Desktop hat um sen rand wenn ich Antialiasing mache anzupassen.
Damit sollte der Übergang flüssig erscheinen und nicht wie raufgesetzt und die pixelkanten nicht mehr sichtbar.

Gandalfus · Beiträge: 129

Alternative von mir:
blubplayer.de/tippfarbenaendern.html
und
blubplayer.de/tippfarbentoleranz.html

_________________
Wennn man feststellt, dass es drei Moeglichkeiten gibt, die einen Vorgang schiefgehen lassen koennen und man diese ausschaltet, entstehen automatisch drei neue Moeglichkeiten.

Heiko · Beiträge: 3169 Erhaltene Danke: 11

@Farbtoleranz: Ist so nicht korrekt. Wenn es sich wirklich um Farbtoleranz handeln soll, musste abs nehmen.

Gandalfus · Beiträge: 129

warum?

_________________
Wennn man feststellt, dass es drei Moeglichkeiten gibt, die einen Vorgang schiefgehen lassen koennen und man diese ausschaltet, entstehen automatisch drei neue Moeglichkeiten.

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Ah k, ich geb mich geschlagen, hab nur den ersten Vergleich gelesen

.

Statt

markieren

Delphi-Quelltext

1:	(GetBValue(Color)>=(p^[1]-Grenze)) and (GetBValue(Color)<=(p^[1]+Grenze))

kannst du ach folgendes nehmen

markieren

Delphi-Quelltext

1:	(abs(GetBValue(Color)-p^[1])<=Grenze))

ist kürzer vom lesen her

.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme