Durchschnittsfarbe eines Bitmap "schnell" ermitteln

[KodeZwerg]

Guten morgen Gemeinde!

Ein Neuer Tag, ein neues problem

Ich versuche aus einem Bitmap eine Durchschnittsfarbe zu ermitteln.

Bei dummzeuch wurde ich zwar fündig was mir bereits sehr half es zu beschleunigen, aber seine letzte Optimierung bekomme ich einfach nicht hin.

Hier ist das was ich aus seinem guten Beispiel #2 gemacht habe, es funktioniert, aber doch recht langsam:

Delphi-Quellcode:

function TfrmMain.GetAvgBmpColor: TColor;
type
  TRgbTriple = packed record
    // do not change the order of the fields, do not add any fields
    Blue: Byte;
    Green: Byte;
    Red: Byte;
  end;
  TRgbTripleArray = packed array[0..MaxInt div SizeOf(TRgbTriple) - 1] of TRgbTriple;
  PRgbTripleArray = ^TRgbTripleArray;
var
  x, y: Integer;
  r, g, b: Integer;
  Pixel: TRgbTriple;
  Bmp: TBitmap;
  Filename: string;
  fs: TFileStream;
  wic: TWICImage;
  img: TImage;
begin
  Filename := 'X:\Pfad\Bildname.ext';
  if not FileExists(Filename) then
    Exit;
  bmp := TBitmap.Create;
  wic := TWICImage.Create;
  img := TImage.Create(Self);
  fs := TFileStream.Create(Filename, fmOpenRead);
  try
    bmp.PixelFormat := pf24bit;
    fs.Position := 0;
    wic.LoadFromStream(fs);
    Img.Picture.Assign(wic);
    bmp.Width := Img.Picture.Width;
    bmp.Height := Img.Picture.Height;
    bmp.Canvas.Draw(0, 0, Img.Picture.Graphic);
    r := 0; g := 0; b := 0;
    Assert(bmp.PixelFormat = pf24bit);
    for y := 0 to Pred(bmp.Height) do
      begin
        for x := 0 to Pred(bmp.Width) do
          begin
            Pixel := PRgbTripleArray(bmp.Scanline[y])^[x];
            r := r + Pixel.Red;
            g := g + Pixel.Green;
            b := b + Pixel.Blue;
          end;
      end;
    r := r div (bmp.Width * bmp.Height);
    g := g div (bmp.Width * bmp.Height);
    b := b div (bmp.Width * bmp.Height);
  finally
    Result := RGB(r, g, b);
    bmp.Free;
    fs.Free;
    wic.Free;
    img.Free;
  end;
end;

Sorry für meine schludrige code gestaltung, ist erst alpha phase.


Weiß jemand wie man das eventuell mit diesem Code #3 hinbekommt?

Delphi-Quellcode:

// if you are using Delphi 2007 or older you need to correct the NativeInt declaration from 8 bytes to 4 bytes:
{$IF SizeOf(Pointer) = 4}
type
  NativeInt = Integer;
{$IFEND}

function AddToPtr(const _Ptr: Pointer; _Offset: NativeInt): Pointer; inline;
begin
  Result := Pointer(NativeInt(_Ptr) + _Offset);
end;

function PtrDiff(const _Ptr1, _Ptr2: Pointer): NativeInt; inline;
begin
  Result := NativeInt(_Ptr1) - NativeInt(_Ptr2);
end;

var
  BytesPerPixel: NativeInt;
  InScanLine0: Pointer;
  InBytesPerLine: NativeInt;
  OutScanLine0: Pointer;
  InBytesPerLine: NativeInt;
  InPixel: PRgbTriple;
  OutPixel: PRgbTriple;
// ...
  BytesPerPixel := SizeOf(Pixel) 
  InScanLine0 := InBmp.ScanLine[0];
  InBytesPerLine := NativeInt(_InBmp.ScanLine[1]) - NativeInt(InScanLine0);
  OutScanLine0 := _OutputBmp.ScanLine[0];
  OutBytesPerLine := NativeInt(_OutBmp.ScanLine[1]) - NativeInt(OutScanLine0);
  OutPixel := OutScanLine0;
  for y := 0 to Height - 1 do begin
    for x := 0 to Width - 1 do begin
      InPixel := AddToPtr(InScanLine0, InBytesPerLine * y + x * BytesPerPixel);
      Pixel := InPixel^;
      doSomething(Pixel);
      OutPixel := AddToPtr(OutScanLine0, OutBytesPerLine * y + x * BytesPerPixel);
      OutPixel^ := Pixel;
    end;
  end;

Ich bekomme immer den Fehler das "Pixel" nicht mit "InPixel^" kompatibel ist und weiß gerade nicht weiter.

[Renate Schaaf]

Zitat von KodeZwerg:

Ich bekomme immer den Fehler das "Pixel" nicht mit "InPixel^" kompatibel ist und weiß gerade nicht weiter.

Ich finde ums Verrecken nicht, wo du Pixel deklariert hast. Müsste TRGBTriple sein. Ansonsten: OutPixel brauchst du nicht, einfach die Pixel-Werte aufsummieren wie vorher etc., brauch ich wohl nicht zu erklären.

[KodeZwerg]

Zitat von Renate Schaaf:

Zitat von KodeZwerg:

Ich bekomme immer den Fehler das "Pixel" nicht mit "InPixel^" kompatibel ist und weiß gerade nicht weiter.

Ich finde ums Verrecken nicht, wo du Pixel deklariert hast. Müsste TRGBTriple sein. Ansonsten: OutPixel brauchst du nicht, einfach die Pixel-Werte aufsummieren wie vorher etc., brauch ich wohl nicht zu erklären.

Zitat von dummzeuch:

Wo ist denn die Variable Pixel deklariert und als was? Wenn es die irgendwo in der RTL/VCL oder sonstigen Units gibt, die Du einbindest, könnte das die Fehlermeldung erklären.

Der erste code ist aus seinem blog nur halt für mich angepasst.
Der zweite code ist 1:1 aus seinem blog, es sind 3 teile die aufeinander aufbauen.

//edit
ich bin ja auch noch nicht ganz wach, hallo dummzeuch, DANKE für deine blog!!

@TiGü: WAHNSINN!! Danke für code-optimierung plus das einarbeiten des dritten codes!!

[Michael II]

In einigen der hier geposteten Beispiele befürchte ich bei grossen Bitmaps Integerüberlauf in r,g,b.

Wenn zum Beispiel jedes Pixel einer Bitmap einen Rotwert=255 aufweist, dann läuft r nach >maxint/255 Pixeln über.

Oder etwas anders geschrieben: Eine quadratische Bitmap mit >2901 Pixel Seitenlänge und Rotwert=255 wäre nicht gut...

[TiGü]

Du kannst dir noch ein paar Millisekunden sparen, wenn du nicht den "Umweg" über TBitmap machst:

Delphi-Quellcode:

uses
    Winapi.Wincodec;

type
    TWICImageHelper = class helper for TWICImage
        function GetAverageColor: TColor;
    end;

function TForm3.GetAvgBmpColor: TColor;
var
  Filename: string;
  wic: TWICImage;
begin
  Result := 0;
  Filename := 'Dein Pfad zur Bilddatei';
  if not FileExists(Filename) then
    Exit;
  wic := TWICImage.Create;
  try
    wic.LoadFromFile(Filename);
    Result := wic.GetAverageColor;
  finally
    wic.Free;
  end;
end;

{ TWICImageHelper }

function TWICImageHelper.GetAverageColor: TColor;
type
  // copy from Vcl.Graphics
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array [Byte] of Winapi.Windows.TRGBQuad;
var
  LWicBitmap: IWICBitmapSource;
  Stride: Cardinal;
  Buffer: array of Byte;
  x, y: Integer;
  BGRAPixel: TRGBQuad;
  r, g, b, Resolution, LBytesPerScanline: Integer;
  ScanLinePtr: Pointer;
begin
  Result := 0;
  with Self do
  begin
    if FWicBitmap = nil then 
      Exit;

    FWicBitmap.GetSize(FWidth, FHeight);

    Stride := FWidth * 4;
    SetLength(Buffer, Stride * FHeight);

    WICConvertBitmapSource(GUID_WICPixelFormat32bppBGRA, FWicBitmap, LWicBitmap);
    LWicBitmap.CopyPixels(nil, Stride, Length(Buffer), @Buffer[0]);

    r := 0;
    g := 0;
    b := 0;
    LBytesPerScanline := BytesPerScanline(FWidth, 32, 32);
    for y := 0 to FHeight - 1 do
    begin
      ScanLinePtr := PByte(@Buffer[0]) + y * LBytesPerScanline;
      for x := 0 to FWidth - 1 do
      begin
        BGRAPixel := PRGBQuadArray(ScanLinePtr)^[x];
        r := r + BGRAPixel.rgbRed;
        g := g + BGRAPixel.rgbGreen;
        b := b + BGRAPixel.rgbBlue;
      end;
    end;
    Resolution := FWidth * FHeight;
  end;
  r := r div Resolution;
  g := g div Resolution;
  b := b div Resolution;
  Result := RGB(r, g, b);
end;

Kam bei mir zumindest das gleiche Ergebnis bei rum, bitte nachprüfen!

[KodeZwerg]

Zitat von Michael II:

In einigen der hier geposteten Beispiele befürchte ich bei grossen Bitmaps Integerüberlauf in r,g,b.

Wenn zum Beispiel jedes Pixel einer Bitmap einen Rotwert=255 aufweist, dann läuft r nach >maxint/255 Pixeln über.

Oder etwas anders geschrieben: Eine quadratische Bitmap mit >2901 Pixel Seitenlänge und Rotwert=255 wäre nicht gut...

Danke für diesen Hinweis, mit sowas habe ich nicht gerechnet!
Könnte eine Änderung auf var r, g, b: Int64; da helfen?

Zitat von TiGü:

Du kannst dir noch ein paar Millisekunden sparen, wenn du nicht den "Umweg" über TBitmap machst:
Kam bei mir zumindest das gleiche Ergebnis bei rum, bitte nachprüfen!

Ein paar ms?? Du willst mich jetzt veralbern, das Ding ist enorm schnell! (habe es jetzt nicht gebencht, vorher konnte ich noch zur Tasse greifen, nun ist es bereits nach dem anklicken ausgeführt, Hammer!) Bei mir sind die Werte auch passend/stimmen mit ur-version plus deinem update + deinem update!
Vom Geschwindigkeitsvergleich, meine ur-ur Version war ein Trabbi, danach fand ich dummzeuchs blog und ich hatte einen Sportwagen. Deine erste version war ein Tiefergelegter aufgemotzter Sportwagen, nun ist es ein Formel-1 Wagen!

Ich nahm in Post #1 nur das WIC weil ich vorher nicht wissen kann was für ein Bildformat reinkommt, so als universal Empfänger halt, Konvertierung zu bmp nahm ich weil ich da wusste das es ein ScanLine gibt für die Punkte.

Damit hast Du mir echt eine riesen Freude gemacht! Ganz herzlich vielen Dank für die Mühe, das ist Top!

[TiGü]

Jo, gerne!
Was dem einen sein Problem, ist mein tägliches Code Kata.

Man kann das bestimmt noch weiter optimieren.
Bei der Addition der drei 32-Bit-Zahlen (oder 64-Bit, wenn man in keinen Überlauf will) gibt es bestimmt irgendeine kluge x64-Assemblerfunktion.
Oder man schreibt die Schleifen um, so das nur jedes zweite oder vierte Pixel angeguckt wird.
Je nachdem, wie genau man den Durchschnitt braucht.

[Rollo62]

Zitat von Michael II:

In einigen der hier geposteten Beispiele befürchte ich bei grossen Bitmaps Integerüberlauf in r,g,b.

Ja das sprang mir auch gerade ins Auge.
Trotzdem, theoretisch gibt es Überläufe erst ab Bildgrößen von 24000x24000.
Ich denke es ist noch ein bischen Zeit bis dahin

Aber ich würde auch einen Test o.ä. anlegen, der aufpoppt falls solche Größen mal erreicht werden.

[himitsu]

64 Bit compiliert, kannst Int64 benutzen und hast genug Platz.

Hier wird es ja von der CPU behandelt.

In Win32 machen das Funktionen in der System.pas.
OK, die Addition geht dennoch recht schnell und am Ende das eine DVI, da stört der etwas langsamere Code kaum.

[Michael II]

Zitat von Rollo62:

Zitat von Michael II:

In einigen der hier geposteten Beispiele befürchte ich bei grossen Bitmaps Integerüberlauf in r,g,b.

Ja das sprang mir auch gerade ins Auge.
Trotzdem, theoretisch gibt es Überläufe erst ab Bildgrößen von 24000x24000.
Ich denke es ist noch ein bischen Zeit bis dahin

Aber ich würde auch einen Test o.ä. anlegen, der aufpoppt falls solche Größen mal erreicht werden.

Zitat von TiGü:

Bitte alle Kirchen im Dorf lassen, er verwendetet das für Desktophintergründe.

Und genau deshalb ist es wichtig, dass der Fragende eine wie verlangt schnelle und funktionierende Lösung hat.
Schneller als via Scanline geht's fast nicht.
Bei Verwendung von int64 muss man - wie himitsu schreibt - schon kurz nachdenken, wie das Verhalten in Bezug auf Speed unter 32 bzw. 64 bit ist.

Bei Verwendung von integer für die rgb Werte stösst die Funktion auch bei diesem "Kirche im Dorf Verwendungszweck" zu rasch an ihre Grenzen.
r kann maximal den Wert maxint=2^31-1 speichern.
Wenn in jedem Pixel der Bitmap der Rotwert 255 beträgt, kannst du also maximal trunc((2^31-1)/255) Pixelwerte zusammenzählen.
Bei einer quadratischen Bitmap bist du bei einer Seitenlänge s > sqrt((2^31-1)/255)) am Ende der Fahnenstange angelangt.
Eine 2901*2901 Bitmap ist also gerade noch berechenbar. Grösser darf sie nicht sein.
Oder direkt auf den Anwendungszweck bezogen:
4K Monitor: r erreicht maximal 3840*2160*255 = 2’115’072’000 < 2^31-1, geht gerade noch.
Bereits bei meinem 8K Monitor, den ich nicht habe, fliegt's einem um die Ohren.
Es ist mir bewusst, dass wir hier einen "Nebenschauplatz" diskutieren.
Aber es ist wichtig, dass Code, welcher die eigenen vier Wände verlässt so geschrieben wird, dass er auch in einer Flugzeugsoftware eingebaut zuverlässig funktioniert.