AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Durchschnittsfarbe eines Bitmap "schnell" ermitteln

Durchschnittsfarbe eines Bitmap "schnell" ermitteln

Ein Thema von KodeZwerg · begonnen am 10. Mai 2021 · letzter Beitrag vom 12. Mai 2021
Antwort Antwort
Seite 1 von 6  1 23     Letzte » 
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.685 Beiträge
 
Delphi 11 Alexandria
 
#1

Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 08:53
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.
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat
Renate Schaaf

Registriert seit: 25. Jun 2020
Ort: Lippe
114 Beiträge
 
Delphi 11 Alexandria
 
#2

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 09:21

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.
Renate
  Mit Zitat antworten Zitat
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.058 Beiträge
 
Delphi 10.4 Sydney
 
#3

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 09:22
Delphi-Quellcode:
function TForm3.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;
  wic: TWICImage;
  Resolution: Integer;
  ScanLinePtr: Pointer;
begin
  Result := 0;
  Filename := 'Der magische Pfad';
  if not FileExists(Filename) then
    Exit;
  bmp := TBitmap.Create;
  wic := TWICImage.Create;
  try
    wic.LoadFromFile(Filename);
    bmp.Assign(wic);
    bmp.PixelFormat := pf24bit;
    r := 0;
    g := 0;
    b := 0;
    Assert(bmp.PixelFormat = pf24bit);

    for y := 0 to Pred(Bmp.Height) do
    begin
      ScanLinePtr := bmp.Scanline[y]; // der springende Punkt!
      for x := 0 to Pred(Bmp.Width) do
      begin
        Pixel := PRgbTripleArray(ScanLinePtr)^[x];
        r := r + Pixel.Red;
        g := g + Pixel.Green;
        b := b + Pixel.Blue;
      end;
    end;

    Resolution := (bmp.Width * bmp.Height);
    r := r div Resolution;
    g := g div Resolution;
    b := b div Resolution;
    Result := RGB(r, g, b);
  finally
    bmp.Free;
    wic.Free;
  end;
end;
  Mit Zitat antworten Zitat
Benutzerbild von dummzeuch
dummzeuch

Registriert seit: 11. Aug 2012
Ort: Essen
1.449 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#4

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 09:24
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.
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.
Thomas Mueller
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.685 Beiträge
 
Delphi 11 Alexandria
 
#5

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 09:32

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.
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!!
Gruß vom KodeZwerg

Geändert von KodeZwerg (10. Mai 2021 um 09:43 Uhr)
  Mit Zitat antworten Zitat
Michael II
Online

Registriert seit: 1. Dez 2012
Ort: CH BE Eriswil
703 Beiträge
 
Delphi 11 Alexandria
 
#6

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 09:50
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...
Michael Gasser
  Mit Zitat antworten Zitat
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.058 Beiträge
 
Delphi 10.4 Sydney
 
#7

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 10:54
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!

Geändert von TiGü (10. Mai 2021 um 11:27 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.685 Beiträge
 
Delphi 11 Alexandria
 
#8

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 11:18
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?

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!
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.058 Beiträge
 
Delphi 10.4 Sydney
 
#9

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 11:41
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.
  Mit Zitat antworten Zitat
Rollo62

Registriert seit: 15. Mär 2007
3.882 Beiträge
 
Delphi 12 Athens
 
#10

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 11:19
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.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:25 Uhr.
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