Delphi-PRAXiS
Seite 2 von 3     12 3      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Negativ bei TImage (https://www.delphipraxis.net/67595-negativ-bei-timage.html)

turboPASCAL 17. Apr 2006 14:16

Re: Negativ bei TImage
 
Einfach Scanline verwenden und die Farbwerte umdrehen, fertig.

Delphi-Quellcode:
procedure NegativeBitmapFX(aBitmap: TBitmap);
var
  x, y: integer;
  p: pbytearray;
begin
  aBitmap.PixelFormat := pf24Bit;

  for y := 0 to aBitmap.Height - 1 do
  begin
    p := aBitmap.scanline[y];
    for x := 0 to (aBitmap.Width * 3) - 1 do
      p[x] := 255 - p[x]; // oder: p[x] := not p[x];
  end;
end;

// Aufruf zB. so:

procedure TForm1.Button1Click(Sender: TObject);
begin
  NegativeBitmapFX(image1.picture.bitmap);
  image1.Refresh;
end;

// Edit:
  • Verschlimmbesserung ausgebessert.
  • Die Idee mit dem not hinzugefügt ( :gruebel: auf diese Idee währe ich im Leben nicht gekommen ;))

Martin K 17. Apr 2006 14:24

Re: Negativ bei TImage
 
Also den Code von turboPASCAL verstehe ich nicht.

Es müsste doch so gehen:
Delphi-Quellcode:
procedure Irgendwas;

    function Umkehrfarbe(const Color: TColor): TColor;
    var c1,c2,c3: Byte;
    begin
      c1 := Color div 10000;
      c2 := Color div 100 mod 100;
      c3 := Color mod 10000;
      c1 := 255-c1;
      c2 := 255-c2;
      c3 := 255-c3;
      Result := c1*10000 + c2*100 + c3;
    end;

var Color1,Color2: TColor; i,j: Integer;
begin //Color1 ist die Farbe, die umgekehrt werden soll, also z.B. clRed

Color2 := Umkehrfarbe(Color1);

for i:=1 to Image.Width do
  for j:=1 to Image.Height do
    If Image.Canvas.Pixels[i,j]=Color1 then
      Image.Canvas.Pixels[i,j]:=Color2;
end;

xaromz 17. Apr 2006 14:33

Re: Negativ bei TImage
 
Hallo,
Zitat:

Zitat von Martin K
Also den Code von turboPASCAL verstehe ich nicht.

Da ist auch was falsch.

Versuch's mal hiermit:
Delphi-Quellcode:
procedure NegativeBitmapFX(aBitmap: TBitmap);
var
  x, y: integer; // Koordinaten
  p: pbytearray; // Pixel
begin
  aBitmap.PixelFormat := pf24Bit; // Damit wir 3 Byte pro Pixel haben

  for y := 0 to aBitmap.Height - 1 do // Bildzeilen durchgehen
  begin
    p := aBitmap.scanline[y]; // Pointer auf aktuelle Zeile
    for x := 0 to (aBitmap.Width * 3) - 1 do // Jedes Pixel duchgehen (1 Pixel -> 3 Byte)
      p[x] := not p[x]; // Invertieren
  end;
end;
Wenn Du einzelne Farben prüfen willst, dann versuch Folgendes:
Delphi-Quellcode:
procedure NegativeBitmapFX(aBitmap: TBitmap);
var
  x, y: integer; // Koordinaten
  p: pbytearray; // Pixel
  R, G, B: Byte;
begin
  aBitmap.PixelFormat := pf24Bit; // Damit wir 3 Byte pro Pixel haben

  for y := 0 to aBitmap.Height - 1 do // Bildzeilen durchgehen
  begin
    p := aBitmap.scanline[y]; // Pointer auf aktuelle Zeile
    for x := 0 to aBitmap.Width - 1 do // Jedes Pixel duchgehen
    begin
      B := P[x * 3]; // Die einzelnen Farbwerte holen
      G := P[x * 3 + 1];
      R := P[x * 3 + 2];

      if R = 255 then // wenn Rotanteil voll
      begin
        P[x * 3] := not P[x * 3]; // Farbwerte invertieren
        P[x * 3 + 1] := not P[x * 3 + 1];
        P[x * 3 + 2] := not P[x * 3 + 2];
      end;
    end;
  end;
end;
Gruß
xaromz

turboPASCAL 17. Apr 2006 14:38

Re: Negativ bei TImage
 
Zitat:

Zitat von xaromz
Da ist auch was falsch.

Und was ? :gruebel:

xaromz 17. Apr 2006 14:41

Re: Negativ bei TImage
 
Hallo,
Zitat:

Zitat von turboPASCAL
Und was ? :gruebel:

Delphi-Quellcode:
 p[x] := rgb(255 - p[x], 255 - p[x], 255 - p[x]);
Du weist einem Byte einen RGB-Farbwert (Integer) zu, den Du auch noch mit dreimal dem gleichen Wert erstellst.

Gruß
xaromz

Martin K 17. Apr 2006 14:41

Re: Negativ bei TImage
 
Hab grad was festgestellt:

Das mit der Komplimentärfarbe geht ganz einfach:

Delphi-Quellcode:
function Umkehrfarbe(const Color: TColor): TColor;
begin
  Result := $FFFFFF - Color;
end;

Eichhoernchen 17. Apr 2006 14:42

Re: Negativ bei TImage
 
ich glaube der von turboPascal wird um einiges schneller sein, da Pixels[x,y] doch arg langsam ist, im gegensatz zu Scanline.

Und an deinem ist der "Nachteil" das du immer nur eine Farbe umkehren kannst, bei turbos werden alle Farben umgekehrt, so wie es glaub ich gewollt ist.

Verstehe nicht so ganz wie turboPASCAL da Scanline verwendest, ich benutze es immer so:

Delphi-Quellcode:
...

type Tpixarray = array [1..3] of byte;
var i, j : integer;
    p : ^Tpixarray;
Begin

  bitmap.pixelformat := pf24bit;

  for i := 0 to bitmap.height-1 do
   Begin
    p := fbitmap.ScanLine[i];
    for j := 0 to bitmap.width-1 do
     Begin
      p[1] := (255 - (p[1]));
      p[2] := (255 - (p[2]));
      p[3] := (255 - (p[x]));
     end;
    inc(p);
   end;
end;

xaromz 17. Apr 2006 14:44

Re: Negativ bei TImage
 
Hallo,

das ist üblicher:
Delphi-Quellcode:
function Umkehrfarbe(const Color: TColor): TColor;
begin
  // Result := not ColorToRGB(Color);
  Result := not ColorToRGB(Color) and $FFFFFF; // <-verbessert
end;
Gruß
xaromz

Martin K 17. Apr 2006 14:44

Re: Negativ bei TImage
 
Zitat:

Zitat von Eichhoernchen
Und an deinem ist der "Nachteil" das du immer nur eine Farbe umkehren kannst, bei turbos werden alle Farben umgekehrt, so wie es glaub ich gewollt ist.

Nein, nein, nein, ich will nur eine Farbe umkehren:

Zitat:

Zitat von Martin K
Gibt es eigentlich auch eine Möglichkeit, nur einzelne Farben umzukehren?
Also z.B. will ich nur das, was rot in meinem Image ist (überall wo die Color=clRed ist) durch die Komlimentärfarbe von rot ersetzen.
Alles andere soll aber die alte Farbe behalten.
Ist das irgendwie möglich?


xaromz 17. Apr 2006 14:47

Re: Negativ bei TImage
 
Hallo,
Zitat:

Zitat von Martin K
Nein, nein, nein, ich will nur eine Farbe umkehren

Dazu hab' ich doch schon was gepostet (Post #13), musst Du nur noch an Deine Bedürfnisse anpassen.

Gruß
xaromz


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:16 Uhr.
Seite 2 von 3     12 3      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz