Einzelnen Beitrag anzeigen

TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.070 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