Überflüssigen Hindergrund bei Bildern entfernen

[MuTzE.Y85]

Ich hatte das System nicht gleich verstanden.

Ich werde das bei Gelegenheit mal mit Scanline probieren.
Wenn es klappt poste ich hier gleich die Lösung.

Danke schon mal!

[MuTzE.Y85]

Für alle die das Gleiche suchen hier noch das Ganze mit Scanline:

Code:

uses
  Math;

procedure RemoveBackground(aBitmap: TBitmap);
type
  PixArray = Array [1..3] of Byte;
var
  P: ^PixArray;
  X,Y, aLeft, aBottom, aTop, aRight: Integer;
begin
  aBitmap.PixelFormat := pf24Bit;

  aTop := aBitmap.Height;
  aLeft := aBitmap.Width;
  aBottom := 0;
  aRight := 0;

  for Y := 0 to aBitmap.Height - 1 do
    begin
      P := aBitmap.ScanLine[Y];

      for X := 0 to aBitmap.Width - 1 do
        begin
          if not (P^[1] = 255) and not (P^[2] = 255) and not (P^[3] = 255) then
            begin
              aTop := Min(aTop, Y);
              aBottom := Max(aBottom, Y);
              aLeft := Min(aLeft, X);
              aRight := Max(aRight, X);
            end;
          Inc(P);
        end;
    end;

  aBitmap.Canvas.CopyRect(Rect(0, 0, aBitmap.Width - aLeft - (aBitmap.Width - aRight) + 1, aBitmap.Height - aTop - (aBitmap.Height - aBottom) + 1), aBitmap.Canvas, Rect(aLeft, aTop, aRight + 1, aBottom + 1));
  aBitmap.Height := aBitmap.Height - aTop - (aBitmap.Height - aBottom) + 1;
  aBitmap.Width := aBitmap.Width - aLeft - (aBitmap.Width - aRight) + 1;
end;

Danke nochmal speziell an BUG und Sir Rufo!