Tparallel und Bitmap-Bearbeitung

[himitsu]

Man kann es auch Mathematisch erledigen ... wenn man weiß wie die Daten im Bitmap gespeichert werden.

Das Windows-Bitmap wird von unten nach oben gespeichert.
* Scanline auf die letzte Zeile
* und dann liegen die Linies hinterienander
* zwischenden Lines muß man nur noch das Align beachten, also jeweils auf 4 Byte aufrunden, aber bei 32-Bit-Bitmaps fällt das nicht auf

Delphi-Quellcode:

P: TPixelAarray;  // array[0..z] of TRGB;
P := Scanline[Bitmap.Height - 1];
Pixel := P[(Bitmap.Height - y - 1) * Image.Width + x];

[Harry Stahl]

Zitat von himitsu:

Scanline: Ist das auch wirklich ein 32-Bit-Bitmap?

Scanline kannst Du auch mit einem 24-Bit-Bitmap verwenden, Du musst halt nur berücksichtigen, dass hier auf 3 Bit gezeigt wird (bei 32-Bit auf 4 Bit).

Zitat von Sir Rufo:

Und gleichzeitig frage dich, ob es gut ist, wenn man bei einer parallelen Bearbeitung überall den Bezugspunkt einfach so verschiebt Inc(Ziel); Inc(Quelle); .

OK, in einem Thread ist das wirklich keine gute Idee.

Ich versuche mal einen anderen Ansatz, das mit TTask zu beschleunigen, also einmal den oberen Teil der Bitmap berechnen, dann den unteren Teil, beides halt (fast) gleichzeitig. Da ich in den jeweiligen Threads nur lokale Variablen verwende und auf das zu verändernde Bitmap auf unterschiedliche Bereiche zugreife, dürften doch eigentlich keine Konflikte entstehen, oder?

Dennoch bekommen ich eine Zugriffsverletzung, wenn ich auch den 2. Task starte. Die einzelnen Tasks selber Funktionieren, wenn man nur einen startet, dann macht er, was er soll.

Wo könnte denn jetzt hier der Fehler liegen?

Hier der Source-Code:

Delphi-Quellcode:

    H1 := Bitmap.Height div 2; // obere Hälfte der Bitmap
    H2 := H1+1; // Startpunkt für die untere Hälfte

    SetLength(myTasks, 2);

       // Task 1 verändert die obere Hälfte des Bitmaps
    myTasks[0] := TTask.Create(procedure ()
    var
      Ziel, Quelle : ^TRGBTriple;
      x, y: Integer; OK: Boolean;
      begin
        for y := 0 to H1 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 (Ziel^.rgbtGreen <> 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
      );

    myTasks[0].Start;

    // Task 2 verändert die untere Hälfte des Bitmaps
    myTasks[1] := TTask.Create(procedure ()
    var
      Ziel, Quelle : ^TRGBTriple;
      x, y: Integer; OK: Boolean;
      begin
        for y := H2 to Bitmap.height-1 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 (Ziel^.rgbtGreen <> 255); //<-- Hier kommt eine Access-Violation
            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
      );

    myTasks[1].Start;

    TTask.WaitForAll(myTasks);

Nachtrag: Manchmal läuft es ohne Access-Verletzung durch. Gemessen braucht es dann bei einem 3872 x 2592 Pixel großem Bitmap nur ca. 123 MS, während ohne Parallele Bearbeitung es ca. 185 MS dauert. Wäre also schon eine hilfreiche Beschleunigung, wenn man das stabil hinbekommen könnte.

[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.

[Dejan Vu]

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

[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...

[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);