AGB  ·  Datenschutz  ·  Impressum  







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

Durchschnittsfarbe eines Bitmap "schnell" ermitteln

Ein Thema von KodeZwerg · begonnen am 10. Mai 2021 · letzter Beitrag vom 12. Mai 2021
Antwort Antwort
Seite 2 von 3     12 3      
TiGü

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

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 08: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.472 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#2

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 10. Mai 2021, 08: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
Amateurprofi

Registriert seit: 17. Nov 2005
Ort: Hamburg
1.041 Beiträge
 
Delphi XE2 Professional
 
#3

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 15:16
Guten morgen Gemeinde!

Ein Neuer Tag, ein neues problem
...
Ich versuche aus einem Bitmap eine Durchschnittsfarbe zu ermitteln.
...
Hier ist das was ich aus seinem guten Beispiel #2 gemacht habe, es funktioniert, aber doch recht langsam:
...
Hallo KodeZwerg:
Ich hab dir mal etwas zusammengestoppelt.
Aufruf mit GetAvgColor(Dateiname) oder GetAvgColor(Bitmap)
Mit TestGetAvgColor; hab ich das Ergebnis und die Performance getestet und mit der Funktion aus #3 verglichen.
Die zurückgegebenen Durchschnittsfarben sind identisch, die Ausführungszeiten sind dagegen höchst unterschiedlich.

Delphi-Quellcode:
FUNCTION AvgColor(P,LO,W,H:NativeInt):TColor;
// P : Zeiger auf das erste Pixel der ersten Zeile einer Bitmap
// LO : Offset (in Bytes) auf die jeweils nächste Zeit
// W : Breite der Bitmap
// H : Höhe der Bitmap
{$IFDEF CPUX86}
const
   OfsBlueLo=0; OfsBlueHi=OfsBlueLo+4;
   OfsGreenLo=OfsBlueHi+4; OfsGreenHi=OfsGreenLo+4;
   OfsRedLo=OfsGreenHi+4; OfsRedHi=OfsRedLo+4;
   OfsCount=OfsRedHi+4; OfsH=OfsCount+4; OfsLO=OfsH+4;
   OfsStack=OfsLO+4;
{$ENDIF}
asm
{$IFDEF CPUX86}// EAX=P, EDX=LO, ECX=W, Stack=H
               // Register retten
               push ebx
               push edi
               push esi
               // LO, H und Anzahl Pixel auf Stack legen
               push edx // LO
               mov ebx,H
               push ebx // H
               imul ebx,ecx
               push ebx // Anzahl Pixel
               // Summen auf Stack
               push 0
               push 0
               push 0
               push 0
               push 0
               push 0
               // ESI hinter erste Zeile
               lea ebp,[ecx+ecx*2]
               lea esi,[eax+ebp]
               neg ebp
               // Summen ermitteln
@Loop1: mov edi,ebp
               xor ebx,ebx
               xor ecx,ecx
               xor edx,edx
@Loop2: movzx eax,byte[esi+edi] // Blue
               add ebx,eax
               movzx eax,byte[esi+edi+1] // Green
               add ecx,eax
               movzx eax,byte[esi+edi+2] // Red
               add edx,eax
               add edi,3
               jl @Loop2 // Nächstes Pixel
               add [esp+OfsBlueLo],ebx // Summe Blue
               adc [esp+OfsBlueHi],0
               add [esp+OfsGreenLo],ecx // Summe Green
               adc [esp+OfsGreenHi],0
               add [esp+OfsRedLo],edx // Summe Red
               adc [esp+OfsRedHi],0
               // Zeiger auf nächste Zeile
               add esi,[esp+OfsLO];
               dec [esp+OfsH]
               jnz @Loop1
               // AvgWerte erbitteln
               mov eax,[esp+OfsBlueLo]
               mov edx,[esp+OfsBlueHi]
               div [esp+OfsCount]
               movzx ecx,al
               shl ecx,16
               mov eax,[esp+OfsGreenLo]
               mov edx,[esp+OfsGreenHi]
               div [esp+OfsCount]
               mov ch,al
               mov eax,[esp+OfsRedLo]
               mov edx,[esp+OfsRedHi]
               div [esp+OfsCount]
               mov cl,al
               mov eax,ecx // Result=AvgColor
               // Stack bereinigen
               add esp,OfsStack
               // Register wieder herstellen
               pop esi
               pop edi
               pop ebx
{$ELSE}        // RCX=P, RDX=LO, R8=W, R9=H
               push r12
               push r13
               push r14
               // Anzahl Pixel in R13
               mov r13,R8
               imul R13,R9
               // R11 hinter erste Zeile, R12=-W*3
               lea r12,[r8+r8*2]
               lea r11,[rcx+r12]
               neg r12
               // Summen ermitteln
               xor rcx,rcx // Summe Blue
               xor r8,r8 // Summe Green
               xor r10,r10 // Summe Red
@Loop1: mov r14,r12
@Loop2: movzx rax,byte[r11+r14] // Blue
               add rcx,rax
               movzx rax,byte[r11+r14+1] // Green
               add r8,rax
               movzx rax,byte[r11+r14+2] // Red
               add r10,rax
               add r14,3
               jl @Loop2 // Nächstes Pixel
               // Zeiger auf nächste Zeile
               add r11,rdx;
               dec r9
               jnz @Loop1
               // AvgWerte erbitteln
               mov rax,rcx // Blue
               xor rdx,rdx
               div r13
               movzx rcx,al
               shl rcx,16
               mov rax,r8 // Green
               xor rdx,rdx
               div r13
               mov ch,al
               mov rax,r10
               xor rdx,rdx
               div r13
               mov cl,al
               mov rax,rcx // Result=AvgColor
               // Register wieder herstellen
               pop r14
               pop r13
               pop r12
{$ENDIF}
end;
Delphi-Quellcode:
FUNCTION GetAvgColor(Bmp:TBitmap):TColor; overload;
var LO,P:NativeInt;
begin
   Assert(Bmp.PixelFormat=pf24bit);
   Assert(Bmp.Width>0);
   Assert(Bmp.Height>0);
   P:=NativeInt(Bmp.ScanLine[0]);
   LO:=NativeInt(Bmp.ScanLine[1])-P;
   Result:=AvgColor(P,LO,Bmp.Width,Bmp.Height);
end;
Delphi-Quellcode:
FUNCTION GetAvgColor(Dsn:String):TColor; overload;
var Bmp:TBitmap;
begin
   Result:=0;
   if not FileExists(Dsn) then
      raise Exception.Create('Datei "'+Dsn+'" nicht gefunden');
   Bmp:=TBitmap.Create;
   Bmp.LoadFromFile(Dsn);
   Result:=GetAvgColor(Bmp);
   Bmp.Free;
end;
Delphi-Quellcode:
// Aus #3 TiGü (Filename hier als Parameter statt lokale Variable)
function GetAvgBmpColor(Filename:String): 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;
Delphi-Quellcode:
PROCEDURE TestGetAvgColor;
const Width=2900; Height=2900; Color=$010203;
var T0,T1,T2:Cardinal; R:TRect; Bmp:TBitmap; CL1,CL2:TColor; Dsn:String;
begin
   Bmp:=TBitmap.Create;
   Bmp.PixelFormat:=pf24Bit;
   Bmp.SetSize(Width,Height);
   SetRect(R,0,0,Bmp.Width,Bmp.Height);
   Bmp.Canvas.Brush.Color:=Color;
   Bmp.Canvas.FillRect(R);
   Dsn:=ExtractFilePath(ParamStr(0))+'Test.bmp';
   Bmp.SaveToFile(Dsn);
   Bmp.Free;
   T0:=GetTickCount;
   CL1:=GetAvgColor(Dsn);
   T1:=GetTickCount;
   CL2:=GetAvgBmpColor(Dsn);
   T2:=GetTickCount;
   ShowMessage('$'+IntToHex(CL1,8)+' '+IntToStr(T1-T0)+#13+
               '$'+IntToHex(CL2,8)+' '+IntToStr(T2-T1));
end;
Gruß, Klaus
Die Titanic wurde von Profis gebaut,
die Arche Noah von einem Amateur.
... Und dieser Beitrag vom Amateurprofi....

Geändert von Amateurprofi (12. Mai 2021 um 10:11 Uhr) Grund: Fehker in FUNCTION GetAvgColor(Dsn:String):TColor; korrigiert
  Mit Zitat antworten Zitat
Jens01

Registriert seit: 14. Apr 2009
670 Beiträge
 
#4

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 15:24
Zitat:
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
Man kann auch einfach den Durchschnittswert aufaddieren.

vom Prinzip her so:
Delphi-Quellcode:
r := 0;
Resolution := (bmp.Width * bmp.Height);
 for i := to do
  r := r + Pixelwert[i].red / Resolution;

r := round(r);
Achtung: Bin kein Informatiker sondern komme vom Bau.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.203 Beiträge
 
Delphi 12 Athens
 
#5

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 15:52
Mathematisch, von den Grenzen der Floats, macht es leider keinen Unterschied, ob man jedes Pixel dividiert und addiert, oder ob man erst alles addiert und erst am Ende dividiert.
Lezteres ist aber schneller, da "ganz" oft dividieren natürlich langsamter ist, als nur Einmal.

Bei ganz ganz ganz vielen Pixeln ist der Wert irgendwann so groß, dass die nächste Addition des kleinen Wertes, abgeschnitten wird.
Aber Double hat mit 52 Bit (52+11) mehr als der 32 Bit-Integer, somit dauert es da länger, bis zum Rechenfehler/überlauf,
und gegenüber 64 Bit, und dessen Integeroperation (64 Bit-compilat), ist Float in der FPU dann wieder langsamer. (ja, eine einzelne FPU gibt es physisch nicht mehr)

Single mit 23 Bits (23+8) raucht schon zu etwas früher ab.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (11. Mai 2021 um 15:57 Uhr)
  Mit Zitat antworten Zitat
Jens01

Registriert seit: 14. Apr 2009
670 Beiträge
 
#6

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 16:02
Zitat:
Bei ganz ganz ganz vielen Pixeln ist der Wert irgendwann so groß, dass die nächste Addition des kleinen Wertes, abgeschnitten wird.
r wird nicht größer als 255, oder?
Achtung: Bin kein Informatiker sondern komme vom Bau.
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

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

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 16:08
So wie ich es verstanden habe fügt sich ein RBG wert aus 3 DWORDs zusammen.
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat
Amateurprofi

Registriert seit: 17. Nov 2005
Ort: Hamburg
1.041 Beiträge
 
Delphi XE2 Professional
 
#8

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 19:44
@KodeZwerg:

In #16 wurde in den Raum geworfen, ob man nicht einfach ein Resize auf 1x1 Pixel machen kann.
Ich hab das mal geprüft und in meiner Funktion TestGetAvgColor; vor dem Bmp.Free folgendes eingefügt:

Delphi-Quellcode:
   T3:=GetTickCount;
   Bmp2:=TBitmap.Create;
   Bmp2.PixelFormat:=pf24Bit;
   Bmp2.SetSize(1,1);
   SetRect(R,0,0,1,1);
   Bmp2.Canvas.StretchDraw(R,Bmp);
   CL3:=Bmp2.Canvas.Pixels[0,0];
   Bmp2.Free;
   T3:=GetTickCount-T3;
Das ShowMessage am Ende hab ich abgeändert in:

ShowMessage('$'+IntToHex(CL1,8)+' '+IntToStr(T1-T0)+#13+
'$'+IntToHex(CL2,8)+' '+IntToStr(T2-T1)+#13+
'$'+IntToHex(CL3,8)+' '+IntToStr(T3));

Scheint zu funktionieren, was aber auch daran liegen könnte, dass in der Testprozedur alle Pixel die gleiche Farbe haben.
Korrektur: Hab es gerade mit einem echten Bild geprüft.
Die Methode, das Bild auf 1x1 Pixel zu reduzieren, liefert eine andere Durchschnittsfarbe.
Gruß, Klaus
Die Titanic wurde von Profis gebaut,
die Arche Noah von einem Amateur.
... Und dieser Beitrag vom Amateurprofi....
  Mit Zitat antworten Zitat
Michael II

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

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 19:54
@KodeZwerg:

Die Methode, das Bild auf 1x1 Pixel zu reduzieren, liefert eine andere Durchschnittsfarbe.

Ich nehme auch an, dass GDI+ beim Skalieren auf 1x1 nicht oft die gleiche Durchschnittsfarbe berechnet. Du könntest ja auch auf ein 10x10 oder ähnlich skalieren und dort rechnen.

Die 1x1 Bitmap Farbe hängt natürlich u.a. vom verwendeten Skalier-Algorithmus ab.

Bliebe die Frage: Welche Farbe ein Mensch als die "bessere" Durchschnittsfarbe bewerten würde.

Hast du irgendwo einen Link auf wissenschaftliche Literatur (wäre interessant), wo sowas wie eine "Durchschnittsfarbe" besprochen wird. Ich nehme an, dass in der Grafikbranche nicht einfach über RGB addiert und der Mittelwert genommen wird. Da werden doch sicher andere Modelle "bemüht"?
Michael Gasser
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

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

AW: Durchschnittsfarbe eines Bitmap "schnell" ermitteln

  Alt 11. Mai 2021, 20:15
In #16 wurde in den Raum geworfen, ob man nicht einfach ein Resize auf 1x1 Pixel machen kann.
Ich hab das mal geprüft und in meiner Funktion TestGetAvgColor; vor dem Bmp.Free folgendes eingefügt:
Scheint zu funktionieren, was aber auch daran liegen könnte, dass in der Testprozedur alle Pixel die gleiche Farbe haben.
Korrektur: Hab es gerade mit einem echten Bild geprüft.
Die Methode, das Bild auf 1x1 Pixel zu reduzieren, liefert eine andere Durchschnittsfarbe.
Danke für den Test! Das schonmal vorweg.
Anstelle auf 1x1, wäre meine Überlegung ein sinnvolles Resize erst dann durchzuführen wenn Int64 für die Berechnung nicht mehr ausreicht.
Es wurden zwar viele Zahlen in den Raum geworfen, aber wie sollte man da Sinnvoll vorgehen?...

Ein Bild besteht ja aus zwei Dimensionen, ein Int64 ist nur eine.
Was ich meine, gibt es eine logik die so etwas berechnen kann, ein bild kann ja 100 million pixel Hoch aber nur 1 pixel breit sein.
Andersrum genauso.
Oder eben in beide Dimensionen sehr sehr viele Pixel besitzen.
Also es gäbe halt mehr als nur eine Möglichkeit diese berechnung hier zum platzen zu bringen.
Ein Resize auf eine Dimension die es nicht zum platzen bringt, das wäre das Sahnetörtchen
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 3     12 3      


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 14:31 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