weniger Scanline aufrufe ... Graustufenbild

[Michael II]

Hallo bernhardLA

für die Bearbeitung von 8Bit Graustufenbildern kannst du fast 1:1 den Code kopieren. Du musst einfach daran denken, dass ein Pixel nur noch 1 Byte Platz einnimmt.

Hier habe ich dir noch eine recht schnelle Variante für die Umwandlung RGB > GrauGrauGrau (24Bit -> 24Bit).

Du kannst den Farbwerten RGB Gewichte fr,fg,fb (fr+fg+fb sollte <=1 sein) zuordnen.

Da ich hier im UInt64 Bereich rechne (32 Bit würden wohl für diese Aufgabe auch reichen...), sind die Prozeduren v.a. in Windows64 (1 Mio Pixel im Millisekundenbereich) schnell (Windows32 ca. 7 Mal langsamer).

Wenn du immer mit festen Gewichten (fr,fg,fb) rechnen willst, dann lohnt es sich die Prozedur grau_test in Zeile OutPixel^.Blue := ( OutPixel^.Red * mg + OutPixel^.green* mb + OutPixel^.blue* mr + round_sh ) shr sh; entsprechend anzupassen und für mg,mb,mr,sh Konstanten zu verwenden. (Speedgewinn ca. 33%). mr,mg,mb und sh berechnest du mittels intRGB.


Viel Spass.

Delphi-Quellcode:

procedure intRGB( r, g, b : extended; var ir, ig, ib, shift : UInt64);
var
  i : Integer;
  mul : uint64;
  bestshift : UInt64;
  abserr, besterr, hr,hg,hb : extended;
  // Ziel: Bei der Ermittlung der Grauwerte aus (rot,grün,blau) auf Fliesskommazahlen verzichten
  // IN Gewichte r,g,b  grau:= r*rot+g*grün+b*blau
  // OUT ir,ig,ib,shift wobei grau := (ir*rot + ig*grün + ib*blau + 1 shl (shift-1)) shr shift
begin
  shift := 1;
  mul := 2;
  besterr := 4;
  hr := r;
  hg := g;
  hb := b;

  for i := 2 to 56 do
  begin
    hr := hr+hr;
    hg := hg+hg;
    hb := hb+hb;

    abserr := (abs(round(hr)-hr) + abs(round(hg)-hg) + abs(round(hb)-hb));

    if abserr < besterr then
    begin
      besterr := abserr;
      bestshift := shift;
    end;
    (* lesbarer wöre (weiter oben) abserr := .../mul
    schneller ist aber, auf die Division durch mul zu verzichten und stattdessen
    besterr zu verdoppeln:
    *)
    besterr := besterr + besterr;
    inc(shift);
    mul := mul shl 1;
  end;

  shift := bestshift;
  mul := UInt64( 1 ) shl shift;
  ir := round( r*mul);
  ig := round( g*mul);
  ib := round( b*mul);
end;

procedure grau_test(const InBmp : TBitmap; fr:extended=0.299; fg:extended= 0.587; fb:extended = 0.114 );
var  // InBmp OUT : pf24Bit
  SrcScanline : Pointer;
  OutPixel: PRGBTriple;
  deltascan : NativeInt;
  height, width, x, y : Integer;
  round_sh, mr,mg,mb, sh : UInt64;

begin
  Height := InBmp.Height;
  Width := InBmp.Width;
  if height = 0 then exit;

  // Standard YCbCr ITU R470 grau = 0.299*R+0.587*G+0.114*B
  // Alternativ G = 0,2126 R + 0,7152 G + 0,0722
  // GIMP  0.21 × R + 0.72 × G + 0.07 × B


  intRGB( fr,fg,fb, mr,mg,mb, sh );
  round_sh := UInt64( 1 ) shl (sh-1);

  SrcScanline := InBmp.ScanLine[height-1];

  if height > 1 then
  deltascan := NativeInt(InBmp.ScanLine[height-2]) - NativeInt(SrcScanline) else deltascan := width*3;

  for y := Height - 1 downto 0 do
  begin
    OutPixel := SrcScanline;
    for x := 0 to Width - 1 do
    begin
      OutPixel^.Blue := ( OutPixel^.Red * mg + OutPixel^.green* mb + OutPixel^.blue* mr + round_sh ) shr sh;
      OutPixel^.Green := OutPixel^.Blue;
      OutPixel^.Red := OutPixel^.Blue;
      inc(OutPixel);
    end;
    inc(PByte(SrcScanline), deltascan);
  end;
end;

Kleine Korrektur: In der vorher veröffentlichten RGB RGB Prozedur sollte stehen:
if height > 1 then
deltascan := ... else deltascan := width*3; (Damit es auch für Bitmaps mit Höhe 1 klappt.)


Ein Bild mit 753x1200 Bildpunkten auf Notebook 11th Gen Intel(R) Core(TM) i7-11800H wird in 966 Mikrosekunden in Grau umgewandelt. Das kann nur Delphi .