Tparallel und Bitmap-Bearbeitung

[Sir Rufo]

Zum einen hier mal der Vergleich zwischen Normal und Parallel.

Dazu habe ich die procedure einmal so umgeschrieben, dass die auch vernünftig parallelisiert werden kann.

Delphi-Quellcode:

unit BitmapProcessing;

interface

uses
  Winapi.Windows,
  Vcl.Graphics;

procedure HelligkeitNormal( Bitmap: TBitmap; Const Original: TBitmap; Value: integer; IgnoreWhite: Boolean );
procedure HelligkeitParallel( Bitmap: TBitmap; Const Original: TBitmap; Value: integer; IgnoreWhite: Boolean );

implementation

uses
  System.Threading;

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [0 .. 4096] of TRGBTriple;

procedure HelligkeitNormal( Bitmap: TBitmap; Const Original: TBitmap; Value: integer; IgnoreWhite: Boolean );
var
  x, y: integer;
  Quelle, Ziel: PRGBTripleArray;
  n: byte;
  ar: array [0 .. 255] of byte;
  LIdx: integer;
begin
  Bitmap.Assign( Original );

  n := abs( Value );

  if Value > 0
  then
    for x := 0 to 255 do
      if integer( x + n ) > 255
      then
        ar[x] := 255
      else
        ar[x] := x + n
  else
    for x := 0 to 255 do
      if integer( x - n ) < 0
      then
        ar[x] := 0
      else
        ar[x] := x - n;

  for y := 0 to Bitmap.Height - 1 do
    begin
      Ziel := Bitmap.Scanline[y];
      Quelle := Original.Scanline[y];

      for LIdx := 0 to Bitmap.Width - 1 do
        begin

          if not IgnoreWhite or ( ( Quelle[LIdx].rgbtBlue <> 255 ) or ( Quelle[LIdx].rgbtGreen <> 255 ) or ( Ziel[LIdx].rgbtGreen <> 255 ) )
          then
            begin
              Ziel[LIdx].rgbtBlue := ar[Quelle[LIdx].rgbtBlue];
              Ziel[LIdx].rgbtRed := ar[Quelle[LIdx].rgbtRed];
              Ziel[LIdx].rgbtGreen := ar[Quelle[LIdx].rgbtGreen];
            end;

        end;

    end;
end;

procedure HelligkeitParallel( Bitmap: TBitmap; Const Original: TBitmap; Value: integer; IgnoreWhite: Boolean );
var
  // x,
  y: integer;
  Quelle, Ziel: PRGBTripleArray;
  n: byte;
  ar: array [0 .. 255] of byte;
  // LIdx: integer;
begin
  Bitmap.Assign( Original );

  n := abs( Value );

  if Value > 0
  then
    // for x := 0 to 255 do
    TParallel.&For( 0, 255,
        procedure( x: integer )
      begin
        if integer( x + n ) > 255
        then
          ar[x] := 255
        else
          ar[x] := x + n
      end )
  else
    // for x := 0 to 255 do
    TParallel.&For( 0, 255,
      procedure( x: integer )
      begin
        if integer( x - n ) < 0
        then
          ar[x] := 0
        else
          ar[x] := x - n
      end );

  for y := 0 to Bitmap.Height - 1 do
    begin

      Ziel := Bitmap.Scanline[y];
      Quelle := Original.Scanline[y];

      // for LIdx := 0 to Bitmap.Width - 1 do
      TParallel.&For( 0, Bitmap.Width - 1,
        procedure( LIdx: integer )
        begin

          if not IgnoreWhite or ( ( Quelle[LIdx].rgbtBlue <> 255 ) or ( Quelle[LIdx].rgbtGreen <> 255 ) or ( Ziel[LIdx].rgbtGreen <> 255 ) )
          then
            begin
              Ziel[LIdx].rgbtBlue := ar[Quelle[LIdx].rgbtBlue];
              Ziel[LIdx].rgbtRed := ar[Quelle[LIdx].rgbtRed];
              Ziel[LIdx].rgbtGreen := ar[Quelle[LIdx].rgbtGreen];
            end;

        end );

    end;
end;

end.

[Sir Rufo]

@Harry Stahl

Schau dir mal an, was TBitmap.Scanline eigentlich macht, dann sieht man auch, warum das der Zugriff per Pixel so langsam ist und der Zugriff per Scanline schneller (aber eben nur dann, wenn man immer Zeile für Zeile abarbeitet).

Wenn du das parallelsieren möchtest, dann musst du für jeden Task ein eigenes Bitmap zur Verfügung stellen.

[Harry Stahl]

Also nach meinen bisherigen Erfahrungen und Tests ist Scanline immer der Flaschenhals, weil eben Scanline soviel Aufrufe selbst noch tätigt. Meine optimierten Routinen (dazu gehört das gezeigte Beispiel nicht) verwenden immer nur einen einzigen Aufruf von Scanline (um die Startposition zu erhalten), die restlichen Zugriffe finden aufgrund von Berechnungen statt.

Davon abgesehen greife ich hier ja gar nicht auf Pixel (canvas.pixels[x, y]) zu, sondern auf ^TRGBTriple, was letztlich ein Zeiger auf diese Struktur ist:

tagRGBTRIPLE = record
rgbtBlue: Byte;
rgbtGreen: Byte;
rgbtRed: Byte;
end;

Meinst Du, dass Scanline nicht Threadsafe ist? Das könnte ich ja umgehen, indem ich es so mache, wie oben angedeutet habe.

Edit: Habe gerade gesehen, dass Du (Sir Rufo) eine eigene Version entworfen hast. Super. Werde ich gleich mal testen...

[Dejan Vu]

Ist das Parallele jetzt so viel schneller? Da wird ja wieder nur ein Pixel pro Thread verarbeitet.. Bringt es das?

[Sir Rufo]

Zitat von Dejan Vu:

Ist das Parallele jetzt so viel schneller? Da wird ja wieder nur ein Pixel pro Thread verarbeitet.. Bringt es das?

Nun mit der normalen Variante hat er bei einem Bild 2ms benötigt. Mit der parallelen war das schon nach 39ms vollbracht

Es bringt also nur etwas, wenn man die Bilder in separate Einzelbilder unterteilt und dieses Teilbild dann in einem Task abarbeitet. Dabei sollte das Teilbild nicht zu klein sein, sonst macht es keinen Sinn.

[Harry Stahl]

Ja, in der Tat, hier dauert es nun ca. 570 MS, Beschleunigungsziel wird also nicht erreicht.

Aber auf jeden Fall hast Du schon mal mehr Licht ins Dunkel gebracht, also dafür schon mal vielen Dank. Werde weiter probieren und posten, wenn ich die Lösung habe...

[Harry Stahl]

Was seltsam ist: Der zuletzt von mir gepostete Code funktioniert ohne Fehler, wenn man vor Aufruf der beiden Tasks die folgenden beiden Zeilen einfügt:

Delphi-Quellcode:

QB := Original.ScanLine[0];  // <-- Die
ZB := Bitmap.ScanLine[0]; // <-- und die Zeile im Code, dann keine Access-Violation

Also eigentlich ziemlich sinnlos, aber durch den Aufruf von Scanline wird "TBitmap.GetScanline aufgerufen und irgendwas dort bewirkt, dass der Zugriff dann stabil ist:

Delphi-Quellcode:

function TBitmap.GetScanLine(Row: Integer): Pointer;
begin
  Changing(Self);
  with FImage.FDIB, dsbm, dsbmih do
  begin
    if (Row < 0) or (Row >= bmHeight) then
      InvalidOperation(@SScanLine);
    DIBNeeded;
    GDIFlush;
    if biHeight > 0 then  // bottom-up DIB
      Row := biHeight - Row - 1;
    Result := PByte(bmBits) +
      Row * BytesPerScanline(biWidth, biBitCount, 32);
  end;
end;

Noch besser wird die Performance, wenn man bei einer 4-Core-cpu das Bild in 4 Tasks aufteilt und berechnen lässt.

Optimal wäre also, wenn man anhand der verfügbaren cpu-Kerne das Bild in eine entsprechende Anzahl Bereiche einteilt und dann die entsprechende Anzahl von Tasks dynamisch erzeugt. Da werde ich mich jetzt mal ran machen. Die Performance-Gewinne scheinen vielversprechend zu sein...

[Harry Stahl]

OK, so sieht das nun fertig aus, abhängig von der Anzahl der CPUs werden entsprechende Worker-Tasks erzeugt, die dann die einzelnen Bildteile berechnen. Auf einem 4-Kern-PC spürt man wirklich einen deutlichen Unterschied.

Hier die geänderten Teile:

Delphi-Quellcode:

var
  ...
Procedure CreateNewWorkerTask (var T: ITask; L:Integer);
  begin
    T := TTask.Create(procedure ()
    var
      Ziel, Quelle : ^TRGBTriple;
      x, y, Start, Stop: Integer; OK: Boolean;
      begin
        if L = 0 then Start := 0 else Start := L * (Bitmap.Height div cpus);
        if L = 0 then Stop := Bitmap.Height div cpus else Stop := (Bitmap.Height div cpus) * (L+1);

        if Stop > Bitmap.Height-1 then Stop := Bitmap.Height-1;

        for y := Start to Stop do begin
          Ziel   := Bitmap.Scanline[y];
          Quelle := Original.Scanline[y];

          for x := 0 to (Bitmap.Width-1) do begin
            if IgnoreWhite then begin
              OK := (Quelle^.rgbtBlue <> 255) or (Quelle^.rgbtGreen <> 255) or (Quelle^.rgbtred <> 255);
            end else begin
              OK := True;
            end;

            if OK then begin
              Ziel^.rgbtBlue  := ar[Quelle^.rgbtBlue];
              Ziel^.rgbtred   := ar[Quelle^.rgbtred];
              Ziel^.rgbtGreen := ar[Quelle^.rgbtGreen];
            end;

            inc(Ziel);
            inc(Quelle);
          end;
        end;
      end
      );
  end;

begin
...

    QB := Original.ScanLine[0];  // <-- Die
    ZB := Bitmap.ScanLine[0]; // <-- und die Zeile im Code, dann keine Access-Violation

    cpus := GetCPUCount div GetCPULogicalProcessorCount; // Hier in Delphi-Praxis gefunden

    SetLength(myTasks, cpus);

    for L := 0 to cpus-1 do begin
      CreateNewWorkerTask (myTasks[L], L);
      myTasks[L].Start;
    end;

    TTask.WaitForAll(myTasks);

[Harry Stahl]

Also, um das noch abzuschließen: Offensichtlich ist Scanline nicht threadsafe. Daher habe ich Scanline nur einmal außerhalb des Task-Threads verwendet und innerhalb des Tasks greife ich berechnet auf den DIB-Speicher zu.

Auf einer 6-Kern CPU wird das Bild dann mit ca. 40 MS bearbeitet, also mit Parallel-Bearbeitung 4 mal schneller als ohne.

Hier die fertige Lösung für 24 und 32-Bit-Bitmap (32-Bit wird noch ca. 20% schneller berechnet).

Delphi-Quellcode:

// Bitmap = Zielbitmap; Original = Quelle, Value zwischen -240 und + 240
procedure Helligkeit(Bitmap: TBitmap; Const Original : TBitmap; Value: integer; IgnoreWhite: Boolean);
var
  L,xx,LL,UsedCPUs : integer; n : byte;
  ar : array[0..255] of byte;
  myTasks: array of ITask;
  Dest, Src: Pointer;

  Procedure CreateNewWorkerTask24 (var T: ITask; L:Integer);
  begin
    T := TTask.Create(procedure ()
    var
      Ziel, Quelle : ^TRGBTriple;
      x, y, Start, Stop: Integer;
    begin
      if Bitmap.Height = 1 then begin
        Start := 0; Stop := 0;
      end else begin
        if L = 0 then Start := 0 else Start := (L * (Bitmap.Height div UsedCpus)) + 1;
        if L = 0 then Stop := Bitmap.Height div UsedCpus else Stop := (Bitmap.Height div UsedCpus) * (L+1);
        if Stop > Bitmap.Height-1 then Stop := Bitmap.Height-1;
      end;

      for y := Start to Stop do begin
        Ziel := Pointer(Integer(Dest) + LL * Y);
        Quelle := Pointer(Integer(Src) + LL * Y);

        for x := 0 to (Bitmap.Width-1) do begin
          if (IgnoreWhite = false) or (Quelle^.rgbtBlue <> 255) or (Quelle^.rgbtGreen <> 255) or (Quelle^.rgbtred <> 255) then begin
            Ziel^.rgbtBlue  := ar[Quelle^.rgbtBlue];
            Ziel^.rgbtred   := ar[Quelle^.rgbtred];
            Ziel^.rgbtGreen := ar[Quelle^.rgbtGreen];
          end;

          inc(Ziel);
          inc(Quelle);
        end;
      end;
    end
    );
  end;

  Procedure CreateNewWorkerTask32 (var T: ITask; L:Integer);
  begin
    T := TTask.Create(procedure ()
    var
      RGBAQuelle, RGBAZiel: pRGBALine;
      x, y, Start, Stop: Integer;
    begin
      if Bitmap.Height = 1 then begin
        Start := 0; Stop := 0;
      end else begin
        if L = 0 then Start := 0 else Start := (L * (Bitmap.Height div UsedCpus)) + 1;
        if L = 0 then Stop := Bitmap.Height div UsedCpus else Stop := (Bitmap.Height div UsedCpus) * (L+1);
        if Stop > Bitmap.Height-1 then Stop := Bitmap.Height-1;
      end;

      for y := Start to Stop do begin
        RGBAZiel := Pointer(Integer(Dest) + LL * Y); //Bitmap.ScanLine[y];
        RGBAQuelle := Pointer(Integer(Src) + LL * Y); //Original.Scanline[y];

        for x := 0 to (Bitmap.Width-1) do begin
          if RGBAZiel^[x].rgbReserved <> 0 then begin
            if (IgnoreWhite = false) or (RGBAQuelle^[x].rgbBlue <> 255) or (RGBAQuelle^[x].rgbgreen <> 255) or (RGBAQuelle^[x].rgbred <> 255) then begin
              RGBAZiel^[x].rgbBlue := ar[RGBAQuelle^[x].rgbBlue];
              RGBAZiel^[x].rgbred := ar[RGBAQuelle^[x].rgbred];
              RGBAZiel^[x].rgbgreen := ar[RGBAQuelle^[x].rgbgreen];
            end;
          end;
        end;
      end;
    end
    );
  end;

begin
  n := abs(value);

  //Fall berücksichtigen, dass Bitmap nur 1 Zeile hoch oder weniger Zeilen als CPUS an Board
  if Bitmap.Height < CPUsOnBoard then UsedCPUs := Bitmap.height else UsedCPUs := CPUsOnBoard;

  if value > 0 then begin
    for xx := 0 to 255 do if integer(xx + n) > 255 then ar[xx] := 255 else ar[xx] := xx + n
  end else begin
    for xx := 0 to 255 do if integer(xx - n) < 0 then ar[xx] := 0 else ar[xx] := xx - n;
  end;

  Dest := Bitmap.ScanLine[0];
  Src  := Original.ScanLine[0];

  if Bitmap.Height = 1 then begin
    LL := 0;
  end else begin
    LL := Integer(Bitmap.ScanLine[1]) - Integer(Dest);
  end;

  SetLength(myTasks, UsedCpus);

  for L := 0 to UsedCpus-1 do begin
    if Bitmap.pixelformat = pf32bit then begin
      CreateNewWorkerTask32 (myTasks[L], L);
    end else begin
      CreateNewWorkerTask24 (myTasks[L], L);
    end;
    myTasks[L].Start;
  end;

  TTask.WaitForAll(myTasks);
end;

Wenn ich das richtig verstanden habe, muss man hinterher nicht "aufräumen"? Ein Free für den Task gibt es nicht.